Sub ExcelTableToHTMLTable()
Dim ws As Worksheet
Dim rng As Range
Dim i 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 टिप्पणियाँ
Please do not enter any spam link in the comment box.