CODEWITHSUNDEEP
vbaexcel
114
114

Reputation: 926

Cycling Through Files in a Specified Folder and Importing them into Excel

I am trying to find a way to have Excel cycle through a variety of HTML files and import them one at a time, formatting each one in a specified way before moving onto the next file. The files are all in FOLDER2. How can I modify this to account for not just FILE but for FILE 1....n? One immediate issue I'm encountering is that I'm receiving "Run-time error '1004': Microsoft Excel could not open or read this query file." I suspect this is because it is HTML and not XML. When I manually tell Excel to select ALL files there is no problem, but perhaps the macro isn't doing that?

With ActiveSheet.QueryTables.Add(Connection:= _
        "FINDER;file:///C:/Users/FOLDER1/FOLDER2/FILE", Destination:= _
        Range("$A$1"))
        .CommandType = 0
        .Name = "FILE"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
End Sub

UPDATE:

I am trying to modify the following code so that I can simply choose the folder and have it run through that way. Is this a reasonable approach? 

Sub ImportXMLData()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String
Dim xlWkBk As Workbook, xmlFile As Workbook, LastRow As Long
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.html", vbNormal)
Set xlWkBk = ThisWorkbook
While strFile <> ""
  LastRow = xlWkBk.Sheets(1).Cells.SpecialCells(xlCellTypeLastCell).Row + 1
  Set xmlFile = Workbooks.OpenXML(Filename:=strFolder & "\" & strFile)
  xmlFile.Sheets(1).UsedRange.Copy
  xlWkBk.Sheets(1).Cells(LastRow, 1).Paste
  xmlFile.Close SaveChanges:=False
  strFile = Dir()
Wend
Set xmlFile = Nothing: Set xlWkBk = Nothing
Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

Upvotes: 0

Views: 229

Answers (1)

sigil
sigil

Reputation: 9546

You can use the FileSystemObject (need to add reference to Microsoft Scripting Runtime) to loop through the contents of a folder:

sub loopThroughFolder(folderPath as string)

dim fso as new FileSystemObject
dim fileObj as file

for each fileObj in fso.GetFolder(folderPath).Files
 if filenameFitsCriteria(fileObj.name) then
  importFile(fileObj.Path)
next

end sub

For an interface to select a folder, you can look into:

Application.FileDialog(msoFileDialogFolderPicker)

Upvotes: 2

Related Questions