Excel vba: ¿Importar varios files de text y mover files después de la import?

Realmente espero que alguien pueda ayudar con esto. En este momento estoy usando vba para importar cada línea de text de un file de text a una nueva columna en una fila. Y cada vez que ejecuto la function, se crea una nueva fila de datos debajo de la anterior.

Resultados:

Row 1 (Showing Data from TextFile 1) Column A Column B Column C Data Data Data Row 2 (Showing Data from TextFile 2) Column A Column B Column C Data Data Data 

Así que todo esto funciona bien y después de haber importado el text del file, el file se mueve desde mi directory 'no procesado' a un directory llamado 'accionado'.

Entonces, en este momento mi código aún no está allí, actualmente tengo que definir el nombre del file de text para poder importar los datos del file de text a mi spreadsheet y de nuevo estoy definiendo el nombre del file de text que quiero mover, este código solo funcionará actualmente para 1 file de text. Sin embargo, lo que quiero hacer es si hay varios files de text en mi carpeta 'no activados', entonces quiero importar cada uno de estos files de text en una nueva fila, y mover todos los files de text que acabamos de importar. desde mi carpeta "accionado" al mismo time

Aquí está mi código:

 Sub ImportFile() Dim rowCount As Long rowCount = ActiveSheet.UsedRange.Rows.Count + 1 If Cells(1, 1).Value = "" Then rowCount = 1 Close #1 Open "Y:\Incident Logs\Unactioned\INSC89JH.txt" For Input As #1 A = 1 Do While Not EOF(1) Line Input #1, TextLine Cells(rowCount, A) = TextLine A = A + 1 Loop Close #1 Dim d As String, ext, x Dim srcPath As String, destPath As String, srcFile As String srcPath = "Y:\Incident Logs\Unactioned\" destPath = "Y:\Incident Logs\Actioned\" ext = Array("*.txt", "*.xls") For Each x In ext d = Dir(srcPath & x) Do While d <> "" srcFile = srcPath & d FileCopy srcFile, destPath & d Kill srcFile d = Dir Loop Next End Sub 

por favor, ¿alguien puede mostrarme cómo corregiría este código para hacer lo que necesito que haga? Gracias por adelantado

Sugeriría dividir tu código en múltiples funciones.

Puede cambiar el método ImportFile para no matar TODOS los files, sino solo el file en el que opera, y luego hacer que tome un file específico para operar uno a la vez. P.ej:

 Sub ImportFile(directory As String, filename As String) Dim rowCount As Long rowCount = ActiveSheet.UsedRange.Rows.Count + 1 If Cells(1, 1).Value = "" Then rowCount = 1 Close #1 Open directory & filename For Input As #1 A = 1 Do While Not EOF(1) Line Input #1, TextLine Cells(rowCount, A) = TextLine A = A + 1 Loop Close #1 'Move the file and delete it Dim srcPath As String, destPath As String srcPath = directory & filename destPath = "C:\Incident Logs\Actioned\" & filename FileCopy srcPath, destPath Kill srcPath End Sub 

Luego, aquí hay otra publicación de stackoverflow sobre cómo iterar files en una carpeta

Entonces con una pequeña adaptación podrías tener algo como:

 Sub ImportAllFiles() ImportFilesWithExtension "*.txt" ImportFilesWithExtension "*.xls*" End Sub Sub ImportFilesWithExtension(extension As String) Dim StrFile As String, myDir As String myDir = "C:\Incident Logs\Unactioned\" StrFile = Dir(myDir & extension) Do While Len(StrFile) > 0 ImportFile myDir, StrFile StrFile = Dir Loop End Sub 

También lo dividiría en funciones:

 Sub ImportFile() Dim rLastCell As Range Dim vFolder As Variant Dim vFile As Variant Dim colFiles As Collection With ThisWorkbook.Worksheets("Sheet1") 'Note - update sheet name. 'First find the last cell on the named sheet. Set rLastCell = .Cells.Find( _ What:="*", _ LookIn:=xlValues, _ SearchDirection:=xlPrevious) If rLastCell Is Nothing Then 'Set LastCell to A2. Set rLastCell = .Cells(2, 1) Else 'Set LastCell to column A, last row + 1 Set rLastCell = .Range(rLastCell.Row + 1, 1) End If vFolder = GetFolder() Set colFiles = New Collection EnumerateFiles vFolder, "\*.txt", colFiles For Each vFile In colFiles 'Do stuff with the file. 'Close the file and move it. MoveFile CStr(vFile), "S:\Bartrup-CookD\Text 1\" & Mid(vFile, InStrRev(vFile, "\") + 1, Len(vFile)) 'Note - update folder name. Next vFile End With End Sub 

Esto colocará todos los files en una colección:

 Sub EnumerateFiles(ByVal sDirectory As String, _ ByVal sFileSpec As String, _ ByRef cCollection As Collection) Dim sTemp As String sTemp = Dir$(sDirectory & sFileSpec) Do While Len(sTemp) > 0 cCollection.Add sDirectory & "\" & sTemp sTemp = Dir$ Loop End Sub 

Esto le pedirá que select una carpeta:

 ' To Use : vFolder = GetFolder() ' : vFolder = GetFolder("S:\Bartrup-CookD\Customer Services Phone Reports") Function GetFolder(Optional startFolder As Variant = -1) As Variant Dim fldr As FileDialog Dim vItem As Variant Set fldr = Application.FileDialog(msoFileDialogFolderPicker) With fldr .Title = "Select a Folder" .AllowMultiSelect = False If startFolder = -1 Then .InitialFileName = Application.DefaultFilePath Else If Right(startFolder, 1) <> "\" Then .InitialFileName = startFolder & "\" Else .InitialFileName = startFolder End If End If If .Show <> -1 Then GoTo NextCode vItem = .SelectedItems(1) End With NextCode: GetFolder = vItem Set fldr = Nothing End Function 

Esto moverá un file de la carpeta A a la carpeta B:

 '---------------------------------------------------------------------- ' MoveFile ' ' Moves the file from FromFile to ToFile. ' Returns True if it was successful. '---------------------------------------------------------------------- Public Function MoveFile(FromFile As String, ToFile As String) As Boolean Dim objFSO As Object Set objFSO = CreateObject("Scripting.FileSystemObject") On Error Resume Next objFSO.MoveFile FromFile, ToFile MoveFile = (Err.Number = 0) Err.Clear End Function