The code is supposed to extract the first line of each .txt files found in the folders inside the zip file. The zip file contains folders, sub-folders, sub-sub-folders containing .txt, .xls and .pdf files. The txt file I need is located in the first set of folders. The code worked well and as far as I know I have not changed anything. Now I started a error 76, Path not found on line "Set xFolder = xFSO.GetFolder(FolderNameInZip)" Then all of sudden it started working again. Any idea what might be causing this?
Sub ExtractProponents() Dim R As Long, PathFilename As Variant, FolderNameInZip As Variant, oApp As Object, CompanyName As String Dim I As Integer, a As Integer, fileNumber As Long Dim proptblloc As Range Dim proptbl As ListObject Dim xFSO As Object, xFolder As Object, xFile As Object, Filename As Object Application.ScreenUpdating = False Application.AutoCorrect.AutoFillFormulasInLists = False Set proptbl = ThisWorkbook.Worksheets("Prep").ListObjects("Proponents") Set proptblloc = proptbl.HeaderRowRange.Find("No.") a = proptblloc.Row PathFilename = Application.GetOpenFilename("ZipFiles (*.zip), *.zip") If PathFilename = "False" Then Exit Sub R = Cells(Rows.Count, "A").End(xlUp).Row Set oApp = CreateObject("Shell.Application") For Each FolderNameInZip In oApp.Namespace(PathFilename).items Set xFSO = CreateObject("Scripting.FileSystemObject") Set xFolder = xFSO.GetFolder(FolderNameInZip) If xFolder.Files.Count > 1 Then For Each xFile In xFolder.Files If Right(xFile, 4) = ".txt" Then fileNumber = FreeFile Open xFile For Input As #fileNumber Line Input #1, CompanyName I = I + 1 Cells(I + a, "B").Value = CompanyName End If Next Close #fileNumber End If Next Set oApp = Nothing End Sub