- Codice: Seleziona tutto
Sub Elabora_files_di_cartella()
Dim fDialog As FileDialog
Dim i As Integer
Dim uR As Long
Dim uR1 As Long
Dim WK As Workbook
Dim WK1 As Workbook
Dim sh As Worksheet
Dim sh1 As Worksheet
Dim fs As Object
Dim Fold As Object
Dim Nomefile As Object
Dim cartella As Variant
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
MsgBox "Scegli la cartella con i files!", vbInformation, "SCELTA CARTELLA"
With fDialog
.Show
On Error GoTo esci
cartella = .SelectedItems(1)
End With
Set WK = ThisWorkbook
Set sh = WK.Worksheets(1)
Set fs = CreateObject("Scripting.FileSystemObject")
Set Fold = fs.getfolder(cartella)
Set cartella = Fold.Files
For Each Nomefile In cartella
Set WK1 = Workbooks.Open(Nomefile)
Set sh1 = WK1.Worksheets(1)
sh1.Activate
Call Estrazione_Dati
'WK1.Close SaveChanges:=False
'WK1.Close SaveChanges:=True
Next
WK.Save
MsgBox "Fatto!", vbInformation, "SCELTA CARTELLA"
Set fs = Nothing
Set cartella = Nothing
Set Fold = Nothing
esci:
Set fDialog = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Sub Estrazione_Dati()
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Documents and Settings\Admin\Desktop\csvfolder\Pinco Pallino.csv" _
, Destination:=Range("A1"))
.Name = "Pinco Pallino"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
Etc. etc.
Chiedo pertanto se sia possibile questa integrazione.
Cordiali saluti
R
