Я ищу способ создать код, который бы открывал папку, заданную пользователем, искал файлы с определенным именем файла и затем организовывал листы в один файл - да, я знаю, что есть много решений дляоткрыть папку », но я не смог ничего найти, если пользователь выбирает папку с помощью диалогового окна / средства выбора папки, и ее местоположение остается в ячейке.
Боюсь, я начал изучать vba в обратном направлении;но был бы признателен, если бы взглянул на мой код
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
`If Target.Address(0, 0) = "A2" Then
Dim text As String
Dim myfilepath As String
text = "The file location (Double Click or Right Click)"
Range("A2").Value = text
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = -1 Then 'if OK is pressed
myfilepath = .SelectedItems(1)
Target = myfilepath
Else 'if cancel is pressed / or 'If myfilepath = False Then
Target = text
End If
End With
End If
End Sub
'the same code is within (not sure how to put them together!) ->
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
===================================================================
Sub Button1_organise_sheets()
Application.ScreenUpdating = False
Dim wkb As Workbook, wkbFrom As Workbook, ws As Worksheet
Set fso = CreateObject("Scripting.FileSystemObject")
If Range("A2").Value = "The file location (Double Click or Right Click)"
Then 'if the user didn't pick the folder location
MsgBox "Firstly go to step 1)."
Else
Set folder = fso.GetFolder(Range("A2").Value) '& "\")
Strfile = Dir(folder & "\*")
Do While Len(Strfile) > 0 'checks the the number of characters
If Strfile Like "*book*" Then 'or If fso.GetFileName(Strfile) = "*book*"?
Set wkbFrom = Workbooks.Open(Strfile)
'getting the error here:we couldn't find 2019-DECEMBER-book.xls
'(although when I go to folder it actually is there)
Do While wkb.Worksheets.Count <> "1"
'simple code for moving all of the sheets into one
Sheets(2).Select
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Cut
Sheets(1).Select
ActiveSheet.Range("A1").End(xlDown).Offset(1).Select
ActiveSheet.Paste
Application.DisplayAlerts = False
ActiveSheet.Next.Delete
Application.DisplayAlerts = True
.
.
.
Loop
В идеале он запрашивает на шаге 1) выбор папки;2) какую фразу должно содержать имя файла, т.е. «book» 3) для нажатия кнопки, которая организует листы в основной (второй шаг пока пропущен, так как я думаю, что это будет легко)