Looping through txt files, copying contents into workbook, then processing.

[grayme]

Hello. Not being a big VBA programmer, I tend to record macros and then tweak the code.

By doing this I produced a file into which you copy the contents of a *.usi file, it's just a text file that needs extracting from a zip file, into a particular column, to then save down three separate CSV files to be uploaded into our ERP.

Up to last week you had to save the three CSVs separately, it now saves them all straight into a folder the user chooses with individual site and date details in the file names; my understanding of VBA has increased vastly in the process.

Through pulling together various questions and answers others have asked and answers, I have created a macro that will unzip all the *.usi files in a particular folder to a new subfolder, then change the file extensions to *.txt (this may not be too important, but may make things easier).

Now I am trying to add where it obtains the full contents of each of the first text file, copies into the workbook, processes the output as the separate CSV files, then loops through to run for all the text files.

At the moment I am trying to step through the code to get the data to populate [some of] column A of the 'CopyPaste' tab before I tweak to bring it all in, and tweak the previous macro (FormatUSI) to take into account the new process, but it just won't bring any of the text file through.

Am I missing something simple? Thanks in advance.

Function create_temp_zip_folder(ByVal zip_folder As String, ByRef error_message As String) As Boolean

    On Error GoTo error_handler
   
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
   
    If FSO.FolderExists(zip_folder) Then
        FSO.DeleteFolder zip_folder, True
    End If
   
    FSO.CreateFolder zip_folder
   
    create_temp_zip_folder = True
   
    Set FSO = Nothing
   
    Exit Function
   
error_handler:
    error_message = "Error " & Err.Number & ":" & vbCrLf & vbCrLf & Err.Description
   
End Function


Sub Unzip_All()

'Unzip all zips to a folder called 'unzipped' within the chosen folder
    Dim source_folder As String
Dim folder As FileDialog
Set folder = Application.FileDialog(msoFileDialogFolderPicker)
If folder.Show <> -1 Then Exit Sub
source_folder = folder.SelectedItems(1)
    
    Dim current_zip_file As String
    current_zip_file = Dir(source_folder & "\*.zip")
   
    If Len(current_zip_file) = 0 Then
        MsgBox "No zip files found!", vbExclamation
        Exit Sub
    End If
   
    Dim zip_folder As String
    zip_folder = source_folder & "\unzipped"
   
    Dim error_message As String
    If Not create_temp_zip_folder(zip_folder, error_message) Then
        MsgBox error_message, vbCritical, "Error"
        Exit Sub
    End If

    Dim shell_app As Object
    Set shell_app = CreateObject("Shell.Application")
   
    Do While Len(current_zip_file) > 0
        shell_app.Namespace(CVar(zip_folder)).copyhere shell_app.Namespace(source_folder & "\" & current_zip_file).Items
        current_zip_file = Dir
    Loop
   
    Set shell_app = Nothing


'Change the usi file extensions to txt
    With New Scripting.FileSystemObject
        Dim directory As folder
        Set directory = .GetFolder(zip_folder)
        Dim target As File
        For Each target In directory.Files
            If LCase$(.GetExtensionName(target.Name)) = "usi" Then
                Dim newName As String
                newName = .BuildPath(zip_folder, .GetBaseName(target.Name)) & ".txt"
                .MoveFile target.Path, newName
            End If
        Next
    End With
 
'Sub LoopThroughFiles()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim StrFile As String
    Dim C As Integer
    Dim csvWb As Workbook
'    Dim folder As String
'    folder = "E:\my path\"
    StrFile = Dir(zip_folder)

    Set ws = ThisWorkbook.ActiveSheet
 '   C = 1
    Do While Len(StrFile) > 0
        Set csvWb = Workbooks.Open(zip_folder & StrFile)
        csvWb.Sheets(1).Rows("1:95").Copy ws.Range("A" & C) 'Each txt file = 95 rows
        csvWb.Close
'        C = C + 100     'Each txt file = 95 rows
        StrFile = Dir
    Loop
'End Sub

'Sub FormatUSI()

'Application.ScreenUpdating = False

    Sheets("ImportJnl").Select
    Cells.Select
    Selection.Delete Shift:=xlUp 
.................

 

[I_know_nuffin]

try putting debug.print zip_folder & StrFile and adding a break to the code

before

Set csvWb = Workbooks.Open(zip_folder & StrFile)

and see what the output is in the immediate window

you may be missing a " \" in the path

 

[grayme]

try putting debug.print zip_folder & StrFile and adding a break to the code

before

Set csvWb = Workbooks.Open(zip_folder & StrFile)

and see what the output is in the immediate window

you may be missing a " \" in the path

Thank you, I couldn't get it to work but I found and tweaked some other code which is working :

....
    Dim FilesToOpen
    Dim xWb As Workbook
    Dim xToBook As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    Dim xFiles As New Collection
    Dim I As Long
        xStrPath = zip_folder
    If Right(xStrPath, 1) <> "\" Then xStrPath = xStrPath & "\"
    xFile = Dir(xStrPath & "*.txt")
    If xFile = "" Then
        MsgBox "No files found"
        Exit Sub
    End If
    Do While xFile <> ""
        xFiles.Add xFile, xFile
        xFile = Dir()
    Loop
    Set xToBook = ThisWorkbook
    If xFiles.Count > 0 Then
        For I = 1 To xFiles.Count
            Set xWb = Workbooks.Open(xStrPath & xFiles.Item(I))
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    myWB.Activate
    Sheets("CopyPaste").Select
    
  
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    
    
            On Error Resume Next
            ActiveSheet.Name = xWb.Name
            Sitenumber = xWb.Name
            On Error GoTo 0
Application.DisplayAlerts = False
            xWb.Close False
Application.DisplayAlerts = True

    Sheets("ImportJnl").Select
    Cells.Select
    Selection.Delete Shift:=xlUp
.....