Excel Forum

Code: Select all

Sub submitForm()

    Set http = CreateObject("MSXML2.ServerXMLHTTP")
    strURL = "https://docs.google.com/spreadsheets/d/1V0aIM5hIYHdpHTQBA89gBmwIaT7CJ7d9U4TDHI2X8Ws/formResponse?ifq"
    
    intTotalRows = ThisWorkbook.Sheets("Data").Cell(Rows.Count, 1).End(xlUp).Row
    strUniqueID = ThisWorkbook.Sheets("Data").Range("A27").Text
    
    For rowNo = 2 To inTotalRows
        
        strHoscode = ThisWorkbook.Sheets("Data").Range("A" & rowNo).Text
        strHos = ThisWorkbook.Sheets("Data").Range("B" & rowNo).Text
        strTotal_case = ThisWorkbook.Sheets("Data").Range("C" & rowNo).Text
        strTotal_money = ThisWorkbook.Sheets("Data").Range("D" & rowNo).Text
        strMoneyRecives = ThisWorkbook.Sheets("Data").Range("E" & rowNo).Text
        strTotal_caseRecives = ThisWorkbook.Sheets("Data").Range("F" & rowNo).Text
        strTotal_case_notRecives = ThisWorkbook.Sheets("Data").Range("G" & rowNo).Text
        strappeal_money = ThisWorkbook.Sheets("Data").Range("H" & rowNo).Text
        strappeal_case_recives = ThisWorkbook.Sheets("Data").Range("I" & rowNo).Text
        strappeal_case_notrecives = ThisWorkbook.Sheets("Data").Range("J" & rowNo).Text
        strHC_money = ThisWorkbook.Sheets("Data").Range("K" & rowNo).Text
        strHC_case = ThisWorkbook.Sheets("Data").Range("L" & rowNo).Text
        strAE_Money = ThisWorkbook.Sheets("Data").Range("M" & rowNo).Text
        strAE_Case = ThisWorkbook.Sheets("Data").Range("N" & rowNo).Text
        strPP_Money = ThisWorkbook.Sheets("Data").Range("O" & rowNo).Text
        strPP_Case = ThisWorkbook.Sheets("Data").Range("P" & rowNo).Text
        strOPFS_Money = ThisWorkbook.Sheets("Data").Range("Q" & rowNo).Text
        strOPFS_Case = ThisWorkbook.Sheets("Data").Range("R" & rowNo).Text
        strTotalBath = ThisWorkbook.Sheets("Data").Range("S" & rowNo).Text
        strTotalCase = ThisWorkbook.Sheets("Data").Range("T" & rowNo).Text
        strStatus = ThisWorkbook.Sheets("Data").Range("U" & rowNo).Text
    
        strData = "&entry.1409202324=" & strHoscode
        strData = "&entry.869567421=" & strHos
        strData = "&entry.1817716227=" & strTotal_case
        strData = "&entry.1058867388=" & strTotal_money
        strData = "&entry.1200554119=" & strMoneyRecives
        strData = "&entry.618879238=" & strTotal_caseRecives
        strData = "&entry.1326498046=" & strTotal_case_notRecives
        strData = "&entry.1999532598=" & strappeal_money
        strData = "&entry.1684112441=" & strappeal_case_recives
        strData = "&entry.896384008=" & strappeal_case_notrecives
        strData = "&entry.864200327=" & strHC_money
        strData = "&entry.1783506789=" & strHC_case
        strData = "&entry.1844433011=" & strAE_Money
        strData = "&entry.1012783967=" & strAE_Case
        strData = "&entry.118809898=" & strPP_Money
        strData = "&entry.840118038=" & strPP_Case
        strData = "&entry.760455949=" & strOPFS_Money
        strData = "&entry.824958677=" & strOPFS_Case
        strData = "&entry.658889761=" & strTotalBath
        strData = "&entry.1806805796=" & strTotalCase

        strFinalUrl = strURL & strData
        http.Open "POST", strFinalUrl, False
        http.send

        If http.statusText = "OK" Then
            ThisWorkbook.Sheets("Data").Range("U" & rowNo) = "OK"
            strUniqueID = strUniqueID + 1
            ThisWorkbook.Sheets("Data").Range("A27") = strUniqueID
            ThisWorkbook.Sheets("Data").Range("A" & rowNo) = strUniqueID
        End If
        
    Next
    
    MsgBox "Done"

End Sub

Code: Select all

Sub submitFormx()
    With ThisWorkbook.Worksheets("Data")
    Set http = CreateObject("MSXML2.ServerXMLHTTP")
    strURL = "https://docs.google.com/spreadsheets/d/1V0aIM5hIYHdpHTQBA89gBmwIaT7CJ7d9U4TDHI2X8Ws/formResponse?ifq"
    
    intTotalRows = .Cells(.Rows.Count, 1).End(xlUp).Row
    strUniqueID = .Range("A27").Text
    
    For rowNo = 2 To intTotalRows
        strHoscode = .Range("A" & rowNo).Text
        strHos = .Range("B" & rowNo).Text
        strTotal_case = .Range("C" & rowNo).Text
        strTotal_money = .Range("D" & rowNo).Text
        strMoneyRecives = .Range("E" & rowNo).Text
        strTotal_caseRecives = .Range("F" & rowNo).Text
        strTotal_case_notRecives = .Range("G" & rowNo).Text
        strappeal_money = .Range("H" & rowNo).Text
        strappeal_case_recives = .Range("I" & rowNo).Text
        strappeal_case_notrecives = .Range("J" & rowNo).Text
        strHC_money = .Range("K" & rowNo).Text
        strHC_case = .Range("L" & rowNo).Text
        strAE_Money = .Range("M" & rowNo).Text
        strAE_Case = .Range("N" & rowNo).Text
        strPP_Money = .Range("O" & rowNo).Text
        strPP_Case = .Range("P" & rowNo).Text
        strOPFS_Money = .Range("Q" & rowNo).Text
        strOPFS_Case = .Range("R" & rowNo).Text
        strTotalBath = .Range("S" & rowNo).Text
        strTotalCase = .Range("T" & rowNo).Text
        strStatus = .Range("U" & rowNo).Text
    
        strdata = ""
        strdata = "&entry.1409202324=" & strHoscode
        strdata = strdata & "&entry.869567421=" & strHos
        strdata = strdata & "&entry.1817716227=" & strTotal_case
        strdata = strdata & "&entry.1058867388=" & strTotal_money
        strdata = strdata & "&entry.1200554119=" & strMoneyRecives
        strdata = strdata & "&entry.618879238=" & strTotal_caseRecives
        strdata = strdata & "&entry.1326498046=" & strTotal_case_notRecives
        strdata = strdata & "&entry.1999532598=" & strappeal_money
        strdata = strdata & "&entry.1684112441=" & strappeal_case_recives
        strdata = strdata & "&entry.896384008=" & strappeal_case_notrecives
        strdata = strdata & "&entry.864200327=" & strHC_money
        strdata = strdata & "&entry.1783506789=" & strHC_case
        strdata = strdata & "&entry.1844433011=" & strAE_Money
        strdata = strdata & "&entry.1012783967=" & strAE_Case
        strdata = strdata & "&entry.118809898=" & strPP_Money
        strdata = strdata & "&entry.840118038=" & strPP_Case
        strdata = strdata & "&entry.760455949=" & strOPFS_Money
        strdata = strdata & "&entry.824958677=" & strOPFS_Case
        strdata = strdata & "&entry.658889761=" & strTotalBath
        strdata = strdata & "&entry.1806805796=" & strTotalCase

        strFinalUrl = strURL & strdata
        http.Open "POST", strFinalUrl, False
        http.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        http.send

        If http.statusText = "OK" Then
            .Range("U" & rowNo) = "OK"
            strUniqueID = strUniqueID + 1
            .Range("A27") = strUniqueID
            .Range("A" & rowNo) = strUniqueID
        End If
        
    Next
    
    MsgBox "Done"
    End With
End Sub

Code: Select all

Sub PostDataToGoogleForm()
    Dim httpRequest As Object
    Set httpRequest = CreateObject("MSXML2.ServerXMLHTTP")

    Dim formURL As String
    Dim formData As String

    ' Replace with your Google Form URL
    formURL = "<FORM_URL>"

    ' Replace with your form data
    ' Each form field should be in the format "entry.<field_number>.single=<DATA>"
    formData = "entry.0.single=<DATA1>&entry.1.single=<DATA2>&..."

    httpRequest.Open "POST", formURL, False
    httpRequest.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    httpRequest.send formData
End Sub