Using a filepath as a variable Excel 2003

[LolaM]

I'm having problems using variables with filenames.

I have a selection of .html files stored on my hard drive, I want to be able to write a macro that allows me to browse to and select these files (either individually or as a multiple selection), and then have the macro store the filepath(s) for use later.

I then want to create a new worksheet tab in Excel 2003 which uses part of the file name to name the worksheet tab; one new worksheet for each .html file selected. The file name looks like 'CUSTOMERNAME 1234ABCDEFG.html' and I want to use either just '1234ABCDEFG' or '1234ABCDEFG.html' as the worksheet tab name.

Once I have created and named the worksheet tab, I then want to use the full filepath with an insert new web query command to select all of the content of the .html file and import it into the worksheet tab I've just created and named (in cell A1)

I can prompt the user to select an .html file, but I cannot get the macro to store the filepath as a variable for later use. I can also add the new worksheet, but cannot get the macro to name the worksheet using a variable.

Any help or suggestions greatly appreciated!
Thanks in advance,
Lola

 

[tigeravatar]

Lola,

Something like this?

Sub tgr()
    
    Dim FilePaths As Variant: FilePaths = Application.GetOpenFilename("HTML files, *.htm*", , , , True)
    If Not IsArray(FilePaths) Then Exit Sub
    
    Dim FileIndex As Long
    Dim ws As Worksheet
    
    For FileIndex = 1 To UBound(FilePaths)
        Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
        ws.Name = Replace(Split(Right(FilePaths(FileIndex), InStr(StrReverse(FilePaths(FileIndex)), "\")), " ")(1), ".html", "")
        With ws.QueryTables.Add(Connection:="URL;file:///" & Replace(Replace(FilePaths(FileIndex), "\", "/"), " ", "%20"), Destination:=ws.Range("A1"))
            .Name = ws.Name
            .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
    Next FileIndex
    
End Sub

Hope that helps,
~tigeravatar

 

[LolaM]

Hey tigeravatar, that works really nicely! Couple of little tweaks though...

The html files, it turns out, may have more than one space, ie they may be CUSTOMER NAME 1234ABCDEFG.html or CUSTOMERNAME 1234ABCDEFG.html. But the 1234ABCEDFG.html will always be the same 11 chars grouped together immediately before the file extension - its a machine type and serial number, thus is always unique.

What would be the revision to the InStr function to always only pick up those last 11 chars for the worksheet tab name please?

And, how could to add in a step which looks at existing worksheet tab names, and if there already is a tab with the same name, it informs the user and moves onto the next file from the filepath array?

Thanks so much for your help so far!

 

[tigeravatar]

LolaM,

Updated code (didn't know if you had any .htm files along with .html files, so used a select case statement to cover both possibilites):

Sub tgr()
    
    Dim FilePaths As Variant: FilePaths = Application.GetOpenFilename("HTML files, *.htm*", , , , True)
    If Not IsArray(FilePaths) Then Exit Sub
    
    Dim FileIndex As Long
    Dim wsName As String
    Dim ws As Worksheet
    
    For FileIndex = 1 To UBound(FilePaths)
        
        Select Case Right(FilePaths(FileIndex), 1)
            Case "m": wsName = Mid(FilePaths(FileIndex), Len(FilePaths(FileIndex)) - 15, 11)
            Case "l": wsName = Mid(FilePaths(FileIndex), Len(FilePaths(FileIndex)) - 16, 11)
        End Select
        If Not SheetExists(wsName) Then
            Set ws = Sheets.Add(After:=Sheets(Sheets.Count))
            ws.Name = wsName
            With ws.QueryTables.Add(Connection:="URL;file:///" & Replace(Replace(FilePaths(FileIndex), "\", "/"), " ", "%20"), Destination:=ws.Range("A1"))
                .Name = ws.Name
                .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
        Else
            MsgBox wsName & " already exists."
        End If
    Next FileIndex
    
End Sub
Public Function SheetExists(wsName As String) As Boolean
    
    On Error GoTo DoesNotExist
    Dim ws As Worksheet: Set ws = Sheets(wsName)
    SheetExists = True
    Exit Function
    
DoesNotExist:
    SheetExists = False
    Exit Function
    
End Function

Hope that helps,
~tigeravatar

 

[LolaM]

Works *perfectly*!!! Thank you very much tigeravatar!!!