HTML files to XLS

[tmorariu]

I have 1800 html files wich i extracted from a website with HTTrack. In this files are some infos that i need to put in a xls file.

A friend of mine tried to help me but ( he knows programming and stuff ) but told me it is to difficult.

So i start google-ing and this is what i came up with.

1. I used a software for converting html files to xls.
2. Searched this forum for a vb script and actualy worked very well. i have all the infos but one. In the html file there is a link that i must put allso in xls.

Once i converted html to xls the linked dissapeared so i am stuck now.

Searched a lot on google for other ways to do this but there had no luck.

[vb5prgrmr]

If you load the page via a webbrowser control you could use a for each loop to enumerate through the link in the page...

Dim Link As Object, Links As Object

WB.Navigate "file://c:\z\a\forums.html"
Do While WB.ReadyState <> READYSTATE_COMPLETE
  DoEvents
Loop
Set Links = WB.Document.getelementsbytagname("a")
For Each Link In Links
  Debug.Print Link.href
Next

Good Luck

[tmorariu]

I mangaed with help to put on every excell file the link. Eevery link is at A1 cell of every file like this : Mylink ( and it is hyperlinked with the link )

I have the script bellow, I just need to complet it with that A1 in my final xls. Can you help me guys ? i am a newbie

Thanks

Sub test()
Dim wb As Workbook
Dim sht As Worksheet
Dim r As Integer
Set sht = ActiveSheet 'sheet for results
r = 2 '1st row
myDir = "C:\Documents and Settings\Adelina.ADELINA-467578F\Desktop\New Folder\"
myfile = Dir(myDir & "*.xls")
Do While Len(myfile) > 0
Set wb = Workbooks.Open(myDir & myfile)
fnd = False
For Each ws In wb.Sheets
    If ws.Name = "Sheet1" Then fnd = True: Exit For
Next
If fnd Then
With wb.Sheets("Sheet1")
sht.Cells(r, 1) = wb.Name
sht.Cells(r, 2) = .Range("c76")
sht.Cells(r, 3) = .Range("c77")
sht.Cells(r, 4) = .Range("c78")
sht.Cells(r, 5) = .Range("e78")
sht.Cells(r, 6) = .Range("d78")
sht.Cells(r, 7) = .Range("f78")
sht.Cells(r, 8) = .Range("g77")
sht.Cells(r, 9) = .Range("h77")
sht.Cells(r, 10) = .Range("i77")
sht.Cells(r, 11) = .Range("j77")
sht.Cells(r, 12) = .Range("k77")
sht.Cells(r, 13) = .Range("l77")

End With
Else
MsgBox "no cover note in " & wb.Name
End If
wb.Close
myfile = Dir
r = r + 1
Loop
End Sub

[QVeen72]

Hi,

At the end, just write :
sht.Cells(r, 14) = .Range("A1")

[tmorariu]

if so, i am getting the text from a1 and not the url behind the text :)

[QVeen72]

Hi,

Try this :

sht.Cells(r, 14) = Range("A1").Hyp erlinks(1).Addr ess

Regards
Veena

[tmorariu]

Hello. It finaly worked with your help. But now i have another problem. I have other xls files but every each file has no sheet1 but the name of the xls file.
can anyone help me rebuiding the script bellow ?

thanks

Eg of sheetname: dealers0a26



Sub test()
Dim wb As Workbook
Dim sht As Worksheet
Dim r As Integer
Set sht = ActiveSheet 'sheet for results
r = 2 '1st row
myDir = "C:\Documen ts and

Settings\Adelin a.ADELINA-467578F\Desktop \xlsurile\"
myfile = Dir(myDir & "*.xls")
Do While Len(myfile) > 0
Set wb = Workbooks.Open( myDir & myfile)
fnd = False
For Each ws In wb.Sheets
If ws.Name = "Sheet1" Then fnd = True: Exit For
Next
If fnd Then
With wb.Sheets("Shee t1")
sht.Cells(r, 1) = wb.Name
sht.Cells(r, 2) = .Range("c76")
sht.Cells(r, 3) = .Range("c77")
sht.Cells(r, 4) = .Range("c78")
sht.Cells(r, 5) = .Range("d78")
sht.Cells(r, 6) = .Range("e78")
sht.Cells(r, 7) = .Range("a1")


End With
Else
MsgBox "no cover note in " & wb.Name
End If
wb.Close
myfile = Dir
r = r + 1
Loop
End Sub

[QVeen72]

Hi,

Just change it to :
Say,.. If my File is "C:\MyFolder\My ExclName.xls"
and if your sheet name is "MyExclName ", then :

[code=vb]
Dim NName As String
NName = Dir(myFile, vbDirectory)
NName = Left(NName, Len(NName) - 4)
With wb.Sheets(NName )
[/code]

Regards
Veena