Mi puoi aiutare almeno su questa funzione?
In pratica, deve cercare tutte le sottocartelle è all'interno ci sono i file
Purtroppo il vba non mi piace è sono costretto di utilizzare per motivo di lavoro.
Sub getFromSubFolder()
Dim fso As Object
Dim folder As Object
Dim subfolders As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(Range("inputForm").Value)
Set subfolders = folder.subfolders
MyFile = "*.csv"
For Each subfolders In subfolders
Set CurrFile = subfolders.Files
For Each CurrFile In CurrFile
If CurrFile.Name = MyFile Then
.........
End If
Next
Next
Set fso = Nothing
Set folder = Nothing
Set subfolders = Nothing
End Sub
Questo è il restante del codice
Function BrowseFolder(Optional str As String) As String
With Application.FileDialog(msoFileDialogFolderPicker)
If str <> "" Then .InitialFileName = str
.AllowMultiSelect = False
If .Show = -1 Then
BrowseFolder = .SelectedItems(1)
End If
End With
End Function
Sub GetToFolder()
Dim res As String
res = BrowseFolder(Range("OutputForm").Value)
If res <> "" Then
Range("OutputForm").Value = res
End If
End Sub
Sub Move_XL_Files()
Dim sourcePath As String
Dim extn, fil
Dim filCount As Long
If Range("inputForm").Value <> "" And Range("OutputForm").Value <> "" Then
If Range("inputForm").Value <> Range("OutputForm").Value Then
If Right(Range("inputForm").Value, 1) = "\" Then
sourcePath = Left(Range("inputForm").Value, Len(Range("inputForm").Value) - 1)
Else
sourcePath = Range("inputForm").Value
End If
extn = Array("*.csv", "*.xls")
filCount = 0
For Each ext In extn
fil = Dir(sourcePath & "\" & ext)
Do While fil <> ""
FileCopy sourcePath & "\" & fil, Range("OutputForm").Value & "\" & fil
Kill sourcePath & "\" & fil
fil = Dir(sourcePath & "\" & ext)
filCount = filCount + 1
Loop
Next ext
MsgBox "File successo", vbInformation, "Success!"
Else
MsgBox "File non ha avuto successo"
End If
Else
MsgBox "Path non trovato", vbExclamation, "Empty Path"
End If
ActiveWorkbook.Save
ActiveWorkbook.Save
ActiveWorkbook.Save
Range("H4:K4").Select
ActiveCell.FormulaR1C1 = "C:\Output"
Range("H5:K5").Select
ActiveWorkbook.Save
Range("L9").Select
ActiveSheet.Shapes.Range(Array("Button 1")).Select
Selection.OnAction = "Move_XL_Files"
Range("J11").Select
End Sub