html dosyadan bilgi alma

[oydemir]

arkadaşlar ekteki dosyadaki gibi html uzantılı dosya okuyup açmasını istiyorum.teşekkürler

 

[ÖmerBey]

Aşağıdaki kodu ilgili sayfanın kod bölümüne kopyalayınız.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("A:A")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
Application.EnableEvents = False
Set s2 = Sheets("Sayfa2")

s2.Cells.ClearContents
With s2.QueryTables.Add(Connection:= _
        "URL;file:///" & ThisWorkbook.Path & Target.Text & ".html", Destination:=s2.Range("$A$1" _
        ))
    .Name = ""
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlSpecifiedTables
    .WebFormatting = xlWebFormattingNone
    .WebTables = "1,3"
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
End With

Cells(Target.Row, "B") = s2.Range("F3")
Cells(Target.Row, "C") = s2.Range("F4")
Cells(Target.Row, "D") = s2.Range("C6")
Cells(Target.Row, "E") = s2.Range("C7")
Cells(Target.Row, "F") = s2.Range("A12")
Cells(Target.Row, "G") = s2.Range("B12")
Cells(Target.Row, "H") = s2.Range("E12")
Cells(Target.Row, "I") = s2.Range("F12")
Cells(Target.Row, "J") = s2.Range("G12")
Cells(Target.Row, "K") = s2.Range("H12")
Application.EnableEvents = True
End Sub

 

[oydemir]

beceremedim

ilginize teşekkür ederim ama makroda bir bilgim yok ekteki hatayı aldım neyi yapmam gerektiğini tarif edebilirseniz memnun olurum. teşekkürler

 

[ÖmerBey]

Muhtemelen bu hatayı html dosyası bulunamadığı için almışsınızdır. Örneğinizde olduğu gibi html dosyaları ve excel dosyası aynı klasör içerisinde olmalıdır.
Ya bu yüzden hata aldınız ya da belirttiğiniz html dosyası yok.

 

[oydemir]

kusura bakmayın rahatsız ediyor olabilirim ama örnek olarak gönderdiğim dosyanın Sayfa1 sizin gönderdiğiniz kotu yapıştırıp a1 hücresine 86 yazdığım zaman ekran alıntısı olarak gönderdiğim hatayı aldım. Yaptıklarımda bir yanlışlık var mı 86.html ve 87.html dosyalarının olduğu masa üstündeki aynı klasörün içindeler.

 

[oydemir]

s2.Cells.ClearContents
With s2.QueryTables.Add(Connection:= _
"URL;file:///" & ThisWorkbook.Path & Target.Text & ".html", Destination:=s2.Range("$A$1" _
))
bu kodu iki satır yaptığı için hata veriyor olabilir mi

 

[ÖmerBey]

İki satır olmasıyla alakalı değil. Örnek dosyanızda /86 şeklinde yazılı olduğu için kodu ona göre düzenlemiştim.
Sadece 86 şeklinde yazacaksanız ilgili kısmı şu şekilde düzenleyiniz.

"URL;file:///" & ThisWorkbook.Path [COLOR="Red"]& "/" &[/COLOR] Target.Text & ".html", Destination:=s2.Range("$A$1" _
        ))

 

[oydemir]

eline sağlık çok teşekkür ederim.

 

[oydemir]

html

kusura bakmayın rahatsız ediyorum ama bir şey sormak istiyorum html okurken sayfa 2 ye html dosyasını okutmuşsunuz mantık çok güzel olmuş buna dayanarak sizden html uzantılı dosyanın hepsini sayfa 2 ye okutmanızı isteyebilir miyim. ekte bir html dosya gönderiyorum bendeki html dosyaların formatı farklı sizin gönderdiğiniz makroda epey bir uğraştım ama tamamını okutmayı beceremedim.WebTables = "1,4" yaptığımda ekte gönderdiğim html dosyasını okuyor bunda bir sorun yok ama önceki html dosyalarında malik kısmını görmüyor.WebTables = "1,3" yaptığımda önceki html dosyası okuyor fakat şimdi ekte gönderdiğim dosyanın malik kısmını görmüyor. Sizin kurduğunuz mantıkla sayfa 2 ye html uzantılı dosyaların tamamını okutabilirseniz sayfa birdeki işlemleri düşey ara yatay ara ile becerebilirim. tabi sayfa 1de a sütununa yazdığımda olduğu gibi sayfa2 de ki html dosyasının yenilenmesi gerekir. İlginize şimdiden teşekkür ederim

 

[oydemir]

kodda .WebTables = "1,3,4,5" olarak değiştirdiğim zaman istediğim gibi oldu teşekkür ederim.