VBA for HTML - Create HTML Table from Excel Table

Excel table to HTML table
Sub ExcelTableToHTMLTable()

    Dim ws As Worksheet
    Dim rng As Range
    Dim As integer, j as integer
    Dim txtFilePath As String
    Dim txtFileNumber As Integer
    Dim rowDataH As String, rowDataB As String, thStart1 As String,
thStart2 As String, thEnd1 As String,thEnd2 As String
    Dim tbStart1 As String, tbStart2 As String,tbStart3 As String, tbEnd1 As String,tbEnd2 As String,tbEnd3 As String

    'Set the worksheet you want to export from
    Set ws = ThisWorkbook.Sheets("Sheet1") 'Change "Sheet1" to your sheet name

    'Define the path to the text file
    txtFilePath = Application.GetSaveAsFilename( _
                        InitialFileName:="ExportedData.txt", _
                        FileFilter:="Text Files (*.txt), *.txt")

    If txtFilePath = "False" Then Exit Sub 'User cancelled the file dialog

    'Get a free file number
    txtFileNumber = FreeFile

    'Open the text file for output
    Open txtFilePath For Output As txtFileNumber

        'HTML code for table header
        thStart1 = "<div>" & vbNewLine & "<table align=""center"" style=""width: 50%;"">" & vbNewLine & "<thead>" & vbNewLine & "<tr>" & vbNewLine & "<th style=""background-color: #cccccc;"">"
        thStart2 = "<th style=""background-color: #cccccc;"">"
        thEnd1 = "</th>"
        thEnd2 = "</th>" & vbNewLine & "</tr>" & vbNewLine & "</thead>" & vbNewLine & "<tbody>"

        ' Loop through each cell for the table header
        For i = 1 To WorksheetFunction.CountA(Range("1:1"))
            If i = 1 Then
                rowDataH = thStart1 & Cells(1, i).Value & thEnd1
            ElseIf i = WorksheetFunction.CountA(Range("1:1")) Then
                rowDataH = thStart2 & Cells(1, i).Value & thEnd2
            Else
                rowDataH = thStart2 & Cells(1, i).Value & thEnd1
            End If
            Print #txtFileNumber, rowDataH
        Next i

        'HTML code for table body
        tbStart1 = "<tr style=""background-color: #f2f2f2;"">" & vbNewLine & "<td>"
        tbStart2 = "<tr style=""background-color: white;"">" & vbNewLine & "<td>"
        tbStart3 = "<td>"
        tbEnd1 = "</td>"
        tbEnd2 = "</td>" & vbNewLine & "</tr>"
        tbEnd3 = "</td>" & vbNewLine & "</tr>" & vbNewLine & "</tbody>" & vbNewLine & "</table>" & vbNewLine & "</div>"

        ' Loop through each cell for the table body
        For j = 2 To WorksheetFunction.CountA(Range("A:A"))
            For i = 1 To WorksheetFunction.CountA(Range("1:1"))
                If j Mod 2 = 0 Then
                    If i = 1 Then
                        rowDataB = tbStart1 & Cells(j, i).Value & tbEnd1
                    ElseIf i = WorksheetFunction.CountA(Range("1:1")) And j = WorksheetFunction.CountA(Range("A:A")) Then
                        rowDataB = tbStart3 & Cells(j, i).Value & tbEnd3
                    ElseIf i = WorksheetFunction.CountA(Range("1:1")) Then
                        rowDataB = tbStart3 & Cells(j, i).Value & tbEnd2
                    Else
                        rowDataB = tbStart3 & Cells(j, i).Value & tbEnd1
                    End If

                Else

                    If i = 1 Then
                        rowDataB = tbStart2 & Cells(j, i).Value & tbEnd1
                    ElseIf i = WorksheetFunction.CountA(Range("1:1")) And j = WorksheetFunction.CountA(Range("A:A")) Then
                        rowDataB = tbStart3 & Cells(j, i).Value & tbEnd3
                    ElseIf i = WorksheetFunction.CountA(Range("1:1")) Then
                        rowDataB = tbStart3 & Cells(j, i).Value & tbEnd2
                    Else
                        rowDataB = tbStart3 & Cells(j, i).Value & tbEnd1
                    End If
                End If
                'print each line into text file
                Print #txtFileNumber, rowDataB
            Next i
        Next j      

    ' Close the text file
    Close txtFileNumber

    MsgBox "HTML created successfully to " & txtFilePath

End Sub


Open browser in background

Sub OpenEricollFolders()
Dim URL As String
Dim IE As InternetExplorer
   
'Create InternetExplorer Object
    Set IE = New InternetExplorerMedium
 
 With IE
    'Set IE.Visible = True to make IE visible, or False for IE to run in the background
    .Visible = False
    'Define URL
    URL = "https://yourdomain.sharepoint.com/sites/Finmigrationtest/"
    'Navigate to URL
    .Navigate URL
        Do While .ReadyState = 4: DoEvents: Loop
        Do While .ReadyState <> 4: DoEvents: 
Loop
    'Application.Wait (Now() + TimeValue("00:00:20"))
    .Quit
End With
    eEricollFolder = Shell("explorer.exe """ & SharepointAddress_LogFile & "", vbHide)
    'eEricollFolder1 = Shell("iexplorer.exe """ & "" & "", vbHide)
'Set IE = Nothing
    
End Sub


Words count on a web page

Sub WordCountOnWebPage()
    Dim http As Object, html As Object, text As String
    Dim words As Variant
    
    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", "https://yourwebsite.com", False
    http.Send
    
    Set html = CreateObject("HTMLFile")
    html.body.innerHTML = http.responseText
    
    text = html.body.innerText
    words = Split(Trim(text))
    
    MsgBox "Word Count: " & UBound(words) + 1
End Sub

एक टिप्पणी भेजें

0 टिप्पणियाँ