› Sviluppare funzionalita su Microsoft Office con VBA › Selezione e Unione di file .txt
-
AutoreArticoli
-
Ciao,
ho questa macro in Excel che mi permette di:
- aprile FileDialog
- selezionare alcuni file .txt
- questi file verranno copiati in un'altra cartella ( vuota)
- in questa cartella viene creato un file "trend.txt", unione di tutti i txt della cartella
Il file .txt viene creato ma avevo selezionato per esempio due file .txt, uno di questi appare due volte all'interno del file trend.txt (mentre non compare due volte fisicamente nella cartella).
Allego codice:
Sub PickAFile() Dim fd As FileDialog Dim Acti*******ed As Boolean Dim LoopCounter As Long Set fd = Application.FileDialog(msoFileDialogFilePicker) fd.InitialFileName = "C:\Users" fd.AllowMultiSelect = True Acti*******ed = fd.Show If Acti*******ed Then For LoopCounter = 1 To fd.SelectedItems.Count Call CreateCopyOfFile(fd.SelectedItems(LoopCounter)) Next LoopCounter End If End Sub ' NOW I CREATE A COPY OF ALL FILES Sub CreateCopyOfFile(FilePathToCopy As String) Dim fso As Scripting.FileSystemObject Dim FileToCopy As Scripting.File Dim ArchiveFolderPath As String Set fso = New Scripting.FileSystemObject ArchiveFolderPath = "C:\ProgramData\MyFolder\TrendFiles\" If Not fso.FolderExists(ArchiveFolderPath) Then fso.CreateFolder ArchiveFolderPath End If Set FileToCopy = fso.GetFile(FilePathToCopy) FileToCopy.Copy ArchiveFolderPath & "\" & FileToCopy.Name Set fso = Nothing ' NOW I CREATED A MERGE OF ALL FILES c00 = "C:\ProgramData\MyFolder\TrendFiles\" c01 = Dir(c00 & "*.txt") Do Until c01 = "" c02 = c02 & vbCrLf & CreateObject("scripting.filesystemobject").opentextfile(c00 & c01).readall c01 = Dir ' Now I create a merge of all files Loop CreateObject("scripting.filesystemobject").createtextfile(c00 & "trend.txt").write c02 End Sub
Grazie.
Qualcuno che può darmi una mano? Grazie.
Il problema dovrebbe essere solamente in questa parte che serve per unire i file .txt:
c00 = "C:\ProgramData\MyFolder\TrendFiles\" c01 = Dir(c00 & "*.txt") Do Until c01 = "" c02 = c02 & vbCrLf & CreateObject("scripting.filesystemobject").opentextfile(c00 & c01).readall c01 ' Now I create a merge of all files = Dir Loop CreateObject("scripting.filesystemobject").createtextfile(c00 & "trend.txt").write c02
Ciao joanin ti volevo solo informare che questo argomento è già stato trattato in passato , ti basta solamente dare un'occhiata all'archivio storico
Ciao Oscar,
infatti il codice l'ho ripreso da post precedenti e ha sempre funzionato.
Ma nel mio caso copia due volte un file e non riesco ad andarne fuori!
Private Sub CommandButton1_Click() primofile = Application.GetOpenFilename("TEXT Files (*.TXT), *.TXT", , "Seleziona il primo file da scrivere", "Apri", "False") file_selezionato = ActiveWorkbook.Name secondofile = Application.GetOpenFilename("TEXT Files (*.TXT), *.TXT", , "Seleziona il secondo file da aprire", "Apri", "False") file_selezionato = ActiveWorkbook.Name If primofile = False Or secondofile = False Then X = MsgBox("I FILE NON SONO STATI UNITI", vbCritical) Application.CutCopyMode = False End End If Open primofile For Input As #1 Open "c:prova.txt" For Output As #2 Do Until EOF(1) Line Input #1, Data Debug.Print Data Print #2, Data Loop Close Open secondofile For Input As #1 Open "c:prova.txt" For Append As #2 Do Until EOF(1) Line Input #1, Data Debug.Print Data Print #2, Data Loop Close End Sub
-
AutoreArticoli