Excel VBA To Send Data From Excel Sheet To The Google Sheet

 

VBA Code -

Option Explicit

Private Sub btnSendDataToGoogleSheet_Click()

    Dim EmpId As Long, EmpName As String, Address As String, Gender As String, Desi As String

    Dim HeaderName As String, SendID As String, Url1 As String, Url2 As String, FinalUrl As String

    Dim TicketInfo As ServerXMLHTTP60

    Dim TRow As Long, CRow As Long

    TRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row

    If TRow < 2 Then Exit Sub

    For CRow = 2 To TRow

        EmpId = Sheet1.Range("A" & CRow).Value

        EmpName = Sheet1.Range("B" & CRow).Value

        Address = Sheet1.Range("C" & CRow).Value

        Gender = Sheet1.Range("D" & CRow).Value

        Desi = Sheet1.Range("E" & CRow).Value

        Url1 = "https://docs.google.com/forms/d/e/1FAIpQLSeUUjHkOE3H8YiIGHlmIymzKxsBuPDHNSbXaOJc1OoQSdaFRg/formResponse?ifq"

        Url2 = "usp=pp_url&entry.423507605=" & EmpId & "&entry.1330651023=" & EmpName & "&entry.1314715852=" & Address & "&entry.507924233=" & Gender & "&entry.730118634=" & Desi & "&submit=Submit"

        FinalUrl = Url1 & Url2

        HeaderName = "Content-Type"

        SendID = "application/x-www.form-urlencoded;charset=utf-8"

        Set TicketInfo = New ServerXMLHTTP60

        TicketInfo.Open "POST", FinalUrl, False

        TicketInfo.setRequestHeader HeaderName, SendID = SendID

        TicketInfo.send

        If TicketInfo.statusText = "OK" Then

        Else

            MsgBox ("Data sending failed...")

        End If

    Next CRow

    MsgBox ("record inserted")

End Sub

YouTube Video -