Excel ile Ptt Barkod Sorgulama

[b]Excel[/b]'de bir hücreye barkod numarası girerek, gönderdiğiniz ya da alıcısı olduğunuz kargonun o ana kadar ki durumunu sayfaya aktarabilirsiniz. 

Sonucu resimde görebilirsiniz.. 
[img] [/img]
Sayfanızdaki formatı resimde gördüğünüz formata ayarlarsanız ve [b]H2[/b] hücresine de sorgulamak istediğiniz [b]Barkod No[/b]'yu yazarsanız, hatasız bir şekilde sorgulama yapıp döküm alabilirsiniz.. 

■ [b]Uygulama için bu kodları kullanabilirsiniz;[/b]

Private Declare Function InternetCheckConnection Lib "wininet.dll" _
    Alias "InternetCheckConnectionA" (ByVal lpszUrl As String, _
    ByVal dwFlags As Long, ByVal dwReserved As Long) As Long
Private Declare Function Murat_OSMA Lib "user32" Alias _
    "ShowWindow" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long

Sub Ptt_Barkod_Sorgulama()
    Dim URL As String, IE As Object, docX As Object
    Dim i As Integer, c As Integer, j As Integer
    
    Range("B2:B8").ClearContents
    Range("D2:D8").ClearContents
    Range("A10:D" & Range("D65536").End(3).Row).Interior.ColorIndex = 0
    Range("A10:D1000").ClearContents
    URL = "https://www.turkiye.gov.tr/ptt-gonderi-takip"
    If (InternetCheckConnection(URL & "/", &H1, 0&) = 0) Then _
        MsgBox "internet bağlantısı yok": Exit Sub
    Set IE = CreateObject("InternetExplorer.Application")
    With IE
        .Navigate URL
        .Visible = True
        Murat_OSMA .hwnd, 2
    Do While .Busy: DoEvents: Loop
    Do Until .ReadyState = 4: DoEvents: Loop
        .Document.all.barkod.Value = Range("H2").Value
        .Document.forms("mainForm").submit
    Do While .Busy: DoEvents: Loop
    Do Until .ReadyState = 4: DoEvents: Loop
      Range("B2").Value = .Document.all.Item(88).innertext
      Range("B3").Value = .Document.all.Item(90).innertext
      Range("B4").Value = .Document.all.Item(92).innertext
      Range("B5").Value = .Document.all.Item(94).innertext
      Range("B6").Value = .Document.all.Item(96).innertext
      Range("B7").Value = .Document.all.Item(98).innertext
      Range("B8").Value = .Document.all.Item(100).innertext
      Range("D3").Value = .Document.all.Item(102).innertext
      Range("D4").Value = .Document.all.Item(104).innertext
      Range("D5").Value = .Document.all.Item(106).innertext
      Range("D8").Value = .Document.all.Item(108).innertext
    On Error Resume Next
    For i = 0 To 1
        If InStr(1, .Document.getelementsbytagname("TABLE")(i).innertext, "No", vbTextCompare) > 0 Then
            Set docX = .Document.getelementsbytagname("TABLE")(i)
            c = 8
            For Each tr In docX.all.tags("TR")
                c = c + 1
                For j = 0 To tr.all.tags("TD").Length - 1
                    Cells(c, j + 1) = tr.all.tags("TD").Item(j).innertext
                Next j
            Next tr
        End If
    Next i
    Range("A9:D" & Range("D65536").End(3).Row).Style = "İyi"
    End With
    Columns.AutoFit
    IE.Quit
    Set IE = Nothing: Set docX = Nothing: URL = "": i = Empty: c = Empty: j = Empty
End Sub

[u]Bilmeyenler için anlatım yapayım:[/u]
Excel'i açın ve sayfadayken ALT+F11 tuşlarına birlikte basın. 
Açılan pencerenin üst menüsünden önce Insert sonra da Module seçin ve kodları açılan boş pencereye yapıştırın. Şimdi makroda herhangi bir satırı seçin ve F5 tuşuna basın. 

Faydalı olması dileğiyle... 

Hoşça kalın !