Çözüldü Google Form Dosya Giriş Log Kaydı

Sub SendToGoogle()
    Dim strURL As String
    Dim regExp As Object, RetVal As Object
    Dim XDoc As Object
    Dim myMsg As String

    Dim URL_First As String
    Dim URL_Last As String
    Dim Form_URL As String
    
    Dim Domain As String
    Dim Bilgisayar As String
    Dim Kullanıcı As String
    Dim IP As String
    Dim Dizin As String
    
    Dim Ülke As String
    Dim Bölge As String
    Dim Şehir As String
    Dim Koordinat As String
    Dim ISP As String

    
    Dim TicketInfo As MSXML2.ServerXMLHTTP60
    
    '****
    Set XDoc = CreateObject("MSXML2.DOMDocument")
    XDoc.async = False
    XDoc.validateOnParse = False
    
    strURL = "http://ip-api.com/xml/" & myIP
    XDoc.Load strURL
    '****
    
    
    With CreateObject("htmlfile")
        .parentWindow.execScript "function encode(s) {return encodeURIComponent(s);}", "jscript"

        Domain = CreateObject("WScript.Network").Userdomain
        Bilgisayar = CreateObject("WScript.Network").ComputerName
        Kullanıcı = CreateObject("WScript.Network").userName
        IP = XDoc.SelectSingleNode("query/query").Text
        Dizin = ThisWorkbook.FullName
            
        Ülke = XDoc.SelectSingleNode("query/country").Text
        Bölge = XDoc.SelectSingleNode("query/regionName").Text
        Şehir = XDoc.SelectSingleNode("query/city").Text
        Koordinat = "Enlem:" & XDoc.SelectSingleNode("query/lat").Text & " Boylam:" & XDoc.SelectSingleNode("query/lon").Text
        ISP = XDoc.SelectSingleNode("query/isp").Text & " - " & XDoc.SelectSingleNode("query/as").Text



    End With

    URL_First = "https://docs.google.com/forms/d/e/1FAIpQLSeKGcGN63yBLRriQj-KnH-dR_l5PfkPGjFlHDpLMRp7SSwVsA/formResponse?ifq"
    URL_Last = "&entry.1650780505=" & Domain & "&entry.1199076192=" & Bilgisayar & "&entry.1512067980=" & Kullanıcı & "&entry.1009622849=" & IP & "&entry.1677665363=" & Dizin & "&entry.1717022088=" & Ülke & "&entry.1634585580=" & Bölge & "&entry.776573063=" & Şehir & "&entry.1853171862=" & Koordinat & "&entry.529380012=" & ISP & "&submit=Submit"
    Form_URL = URL_First & URL_Last

    Set TicketInfo = New ServerXMLHTTP60
    TicketInfo.Open "POST", Form_URL, False
    TicketInfo.setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset= utf-8"
    TicketInfo.send
    If TicketInfo.statusText = "OK" Then
        Call Reset
        MsgBox "Veri Aktarma İşlemi Başarılı!"
    Else
        MsgBox "Bir Problem Var."
    End If
    
    Set RetVal = Nothing
    Set regExp = Nothing
    Set XDoc = Nothing
    
End Sub

Private Sub CommandButton1_Click()
    Dim i As VbMsgBoxResult
    i = MsgBox("Bilgiler Aktarılsın mı?", vbYesNo + vbQuestion, "Transfer")
    If i = vbNo Then Exit Sub
    Call SendToGoogle
End Sub