EXCEL TOOLS
Excel Add-ins ที่พัฒนาโดยคุณสันติพงศ์ ณสุย (MVP Excel 2010-2020) ด้วยภาษา C# เพื่อแก้ไขปัญหาไฟล์ใหญ่ คำนวณนาน ทำงานช้า จัดการข้อมูลต่าง ๆ ที่ทำงานประจำวันได้อย่างสะดวกรวดเร็ว สนใจคลิกไปดูได้ที่นี่ครับ => Excel Tools
Excel Add-ins ที่พัฒนาโดยคุณสันติพงศ์ ณสุย (MVP Excel 2010-2020) ด้วยภาษา C# เพื่อแก้ไขปัญหาไฟล์ใหญ่ คำนวณนาน ทำงานช้า จัดการข้อมูลต่าง ๆ ที่ทำงานประจำวันได้อย่างสะดวกรวดเร็ว สนใจคลิกไปดูได้ที่นี่ครับ => Excel Tools
[code]
และปิดด้วย [/code]
ตัวอย่างเช่น [code]dim r as range[/code]
เพื่อให้แตกต่างจากข้อความทั่วไป สะดวกในการอ่านและทดสอบ (คลิกเพื่อดูตัวอย่าง)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
cell(rows.count,rowno)
ที่ถูกควรเป็น cells(rows.count,rowno)
intTotalRows
เขียนไม่เหมือนกันผมปรับแก้ไขตามที่อาจารย์แล้วครับ สามารถรัน VBA ได้ ไม่ติด error อะไร แต่ไม่สามารถส่งข้อมูลไปที่ google sheet ได้ครับsnasui wrote: Sun May 12, 2024 9:12 am ช่วยแจ้ง Error ที่พบ จับภาพนั้นมาด้วยจะได้เข้าถึงปัญหาได้โดยไวครับ
ที่มองเร็ว ๆ แล้วเห็นว่าไม่ถูกต้องตอนนี้มี 3 อย่างคือ
- ใน Code อ้างชีตชื่อ Data แต่ไม่มีชีตนี้อยู่จริง
- ใน Code อ้างตำแหน่งเซลล์เป็น
cell(rows.count,rowno)
ที่ถูกควรเป็นcells(rows.count,rowno)
- ตัวแปร
intTotalRows
เขียนไม่เหมือนกัน
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