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
rivate Sub Form_Load()
Dim rsLive As Recordset
Dim fld As Field
Dim Db As Database
Dim oXML As Object
Dim strToken As String
Dim strMessage As String
Dim strDate As String
Dim URL As String
Set Db = CurrentDb()
Set rsLive = Db.OpenRecordset("Query1")
While Not rsLive.EOF
For Each fld In rsLive.Fields
If fld.Name Like "S*" Then
If fld & "" = "Expire" Then
'Line Notify Token
strToken = "ZrbMsogrStOtPH5RGH46CORbjWldrut9A8ahOuE3Vf2"
URL = "https://notify-api.line.me/api/notify"
strDate = Format(Now, "DD/MM/YYYY - HH:MM:SS")
'Line Message
strMessage = "message=MS Access "
'Ajax
Set oXML = CreateObject("Microsoft.XMLHTTP")
With oXML
'Line Post
.Open "POST", URL, 0
'Header
.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.SetRequestHeader "Authorization", "Bearer " & strToken
'Ajax
.send (strMessage)
'Line Check Print
Debug.Print oXML.responseText
End With
'Line
Set oXML = Nothing
End If
End If
Next
rsLive.MoveNext
Wend
rsLive.Close
Set rsLive = Nothing
Db.Close
Set Db = Nothing
End Sub
Code: Select all
'Other code
Dim strUser as String
Set Db = CurrentDb()
Set rsLive = Db.OpenRecordset("Query1")
While Not rsLive.EOF
For Each fld In rsLive.Fields
if fld.Name = "Name" Then
strUser = fld.Value
end if
If fld.Name Like "S*" Then
If fld & "" = "Expire" Then
'Line Notify Token
strToken = "ZrbMsogrStOtPH5RGH46CORbjWldrut9A8ahOuE3Vf2"
URL = "https://notify-api.line.me/api/notify"
strDate = Format(Now, "DD/MM/YYYY - HH:MM:SS")
'Line Message
strMessage = "message=MS Access " & strUser
'Other code
Code: Select all
Private Sub Form_Load()
Dim rsLive As Recordset
Dim fld As Field
Dim Name As String
Dim Db As Database
Dim oXML As Object
Dim strToken As String
Dim strMessage As String
Dim strDate As String
Dim URL As String
Dim Site As String
Dim count As String
Dim strUser As String
Set Db = CurrentDb()
Set rsLive = Db.OpenRecordset("Query1")
count = "a"
While Not rsLive.EOF
For Each fld In rsLive.Fields
If fld.Name = "Name" Then
strUser = fld.Value
End If
If fld.Name Like "S*" Then
If fld & "" = "Expire" Then
Site = fld.Name
'Line Notify Token
strToken = "ZrbMsogrStOtPH5RGH46CORbjWldrut9A8ahOuE3Vf2"
URL = "https://notify-api.line.me/api/notify"
strDate = Format(Now, "DD/MM/YYYY - HH:MM:SS")
'Line Message
strMessage = "message=" & vbNewLine & "Name : " & strUser & vbNewLine & "Site : " & Site & vbNewLine & "Company : PTT "
'Ajax
Set oXML = CreateObject("Microsoft.XMLHTTP")
With oXML
'Line Post
.Open "POST", URL, 0
'Header
.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.SetRequestHeader "Authorization", "Bearer " & strToken
'Ajax
.send (strMessage)
'Line Check Print
Debug.Print oXML.responseText
End With
'Line
Set oXML = Nothing
count = c
ElseIf count = "a" Then
count = "b"
'Line Notify Token
strToken = "ZrbMsogrStOtPH5RGH46CORbjWldrut9A8ahOuE3Vf2"
URL = "https://notify-api.line.me/api/notify"
strDate = Format(Now, "DD/MM/YYYY - HH:MM:SS")
'Line Message
strMessage = "message= No Expire"
'Ajax
Set oXML = CreateObject("Microsoft.XMLHTTP")
With oXML
'Line Post
.Open "POST", URL, 0
'Header
.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.SetRequestHeader "Authorization", "Bearer " & strToken
'Ajax
.send (strMessage)
'Line Check Print
Debug.Print oXML.responseText
End With
'Line
Set oXML = Nothing
End If
End If
Next
rsLive.MoveNext
Wend
rsLive.Close
Set rsLive = Nothing
Db.Close
Set Db = Nothing
End Sub
ค่อย ๆ ถามตอบกันไปครับ
rsLive.MoveNext
ให้ตรวจสอบตัวนับว่ามีค่า > 0 หรือไม่ ถ้าใช่แสดงว่าเจอคำว่า Expire จึงค่อยสั่งให้ทำงานตามที่ต้องการ จากนั้นถึงจะ rsLive.MoveNext
เช่นนี้เป็นต้นif rsLive.Fields(0).value = "Expire" then count = count + 1
Code: Select all
Private Sub Form_Load()
Dim rsLive As Recordset
Dim fld As Field
Dim Name As String
Dim Db As Database
Dim oXML As Object
Dim strToken As String
Dim strMessage As String
Dim strDate As String
Dim URL As String
Dim Site As String
Dim count As Integer
Dim strUser As String
Set Db = CurrentDb()
Set rsLive = Db.OpenRecordset("Query1")
count = 0
While Not rsLive.EOF
For Each fld In rsLive.Fields
If fld.Name = "Name" Then
strUser = fld.Value
End If
If fld.Name Like "S*" Then
If fld & "" = "Expire" Then
Site = fld.Name
count = count + 1
If count > 0 Then
'Line Notify Token
strToken = "ZrbMsogrStOtPH5RGH46CORbjWldrut9A8ahOuE3Vf2"
URL = "https://notify-api.line.me/api/notify"
strDate = Format(Now, "DD/MM/YYYY - HH:MM:SS")
'Line Message
strMessage = "message=" & vbNewLine & "Name : " & strUser & vbNewLine & "Site : " & Site & vbNewLine & "Company : PTT "
'Ajax
Set oXML = CreateObject("Microsoft.XMLHTTP")
With oXML
'Line Post
.Open "POST", URL, 0
'Header
.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.SetRequestHeader "Authorization", "Bearer " & strToken
'Ajax
.send (strMessage)
'Line Check Print
Debug.Print oXML.responseText
End With
'Line
Set oXML = Nothing
End If
End If
End If
Next
rsLive.MoveNext
Wend
rsLive.Close
Set rsLive = Nothing
Db.Close
Set Db = Nothing
If count = 0 Then
'Line Notify Token
strToken = "ZrbMsogrStOtPH5RGH46CORbjWldrut9A8ahOuE3Vf2"
URL = "https://notify-api.line.me/api/notify"
strDate = Format(Now, "DD/MM/YYYY - HH:MM:SS")
'Line Message
strMessage = "message= No Expire"
'Ajax
Set oXML = CreateObject("Microsoft.XMLHTTP")
With oXML
'Line Post
.Open "POST", URL, 0
'Header
.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.SetRequestHeader "Authorization", "Bearer " & strToken
'Ajax
.send (strMessage)
'Line Check Print
Debug.Print oXML.responseText
End With
'Line
Set oXML = Nothing
End If
'Me.Text13 = " & count & "
End Sub
Code: Select all
While Not rsLive.EOF
For Each fld In rsLive.Fields
If fld.Name = "Name" Then
strUser = fld.Value
End If
If fld.Name = "*E" Then
strExpireDate = fld.Value
End If
If fld.Name Like "S*" Then
If fld & "" = "Expire" Then
Site = fld.Name
count = count + 1
If count > 0 Then
'Line Notify Token
strToken = "ZrbMsogrStOtPH5RGH46CORbjWldrut9A8ahOuE3Vf2"
URL = "https://notify-api.line.me/api/notify"
โพสต์ Code ทั้งหมดหลังจากปรับมาแล้วด้วยจะได้ช่วยทดสอบให้ได้ครับJetnipit wrote: Tue Nov 30, 2021 9:52 am ผมต้องการให้ Line แสดงวันที่หมดอายุ (ฟิลด์ที่ลงท้ายด้วยตัว E) ของคนนั้นๆด้วยในหัวข้อ EXP ครับ
เบื้องต้นลองใช้โค้ดแบบ Name เหมือนข้อมูลไม่เข้าครับ ไม่ทราบว่าปัญหาอยู่ที่อะไรหรอครับ
Code: Select all
Dim rsLive As Recordset
Dim fld As Field
Dim Name As String
Dim Db As Database
Dim oXML As Object
Dim strToken As String
Dim strMessage As String
Dim strDate As String
Dim URL As String
Dim Site As String
Dim count As Integer
Dim strUser As String
Dim strExpireDate As String
Set Db = CurrentDb()
Set rsLive = Db.OpenRecordset("Query1")
count = 0
While Not rsLive.EOF
For Each fld In rsLive.Fields
If fld.Name = "Name" Then
strUser = fld.Value
End If
If fld.Name = "*E" Then
strExpireDate = fld.Value
End If
If fld.Name Like "S*" Then
If fld & "" = "Expire" Then
Site = fld.Name
count = count + 1
If count > 0 Then
'Line Notify Token
strToken = "ZrbMsogrStOtPH5RGH46CORbjWldrut9A8ahOuE3Vf2"
URL = "https://notify-api.line.me/api/notify"
strDate = Format(Now, "DD/MM/YYYY - HH:MM:SS")
'Line Message
strMessage = "message=*Expired*" & vbNewLine & "Name : " & strUser & vbNewLine & "EXP : " & strExpireDate & vbNewLine & "Site : " & Site & vbNewLine & "Company : PTT "
'Ajax
Set oXML = CreateObject("Microsoft.XMLHTTP")
With oXML
'Line Post
.Open "POST", URL, 0
'Header
.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.SetRequestHeader "Authorization", "Bearer " & strToken
'Ajax
.send (strMessage)
'Line Check Print
Debug.Print oXML.responseText
End With
'Line
Set oXML = Nothing
End If
ElseIf fld & "" = "Close" Then
Site = fld.Name
count = count + 1
If count > 0 Then
'Line Notify Token
strToken = "ZrbMsogrStOtPH5RGH46CORbjWldrut9A8ahOuE3Vf2"
URL = "https://notify-api.line.me/api/notify"
strDate = Format(Now, "DD/MM/YYYY - HH:MM:SS")
'Line Message
strMessage = "message=*Close*" & vbNewLine & "Name : " & strUser & vbNewLine & "EXP : " & strExpireDate & vbNewLine & "Site : " & Site & vbNewLine & "Company : PTT "
'Ajax
Set oXML = CreateObject("Microsoft.XMLHTTP")
With oXML
'Line Post
.Open "POST", URL, 0
'Header
.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.SetRequestHeader "Authorization", "Bearer " & strToken
'Ajax
.send (strMessage)
'Line Check Print
Debug.Print oXML.responseText
End With
'Line
Set oXML = Nothing
End If
End If
End If
Next
rsLive.MoveNext
Wend
rsLive.Close
Set rsLive = Nothing
Db.Close
Set Db = Nothing
If count = 0 Then
'Line Notify Token
strToken = "ZrbMsogrStOtPH5RGH46CORbjWldrut9A8ahOuE3Vf2"
URL = "https://notify-api.line.me/api/notify"
strDate = Format(Now, "DD/MM/YYYY - HH:MM:SS")
'Line Message
strMessage = "message= No Expire"
'Ajax
Set oXML = CreateObject("Microsoft.XMLHTTP")
With oXML
'Line Post
.Open "POST", URL, 0
'Header
.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.SetRequestHeader "Authorization", "Bearer " & strToken
'Ajax
.send (strMessage)
'Line Check Print
Debug.Print oXML.responseText
End With
'Line
Set oXML = Nothing
End If
'Me.Text13 = " & count & "
End Sub
ตัวอย่างการดักจับ Field ที่ลงท้ายด้วย E ครับJetnipit wrote: Tue Nov 30, 2021 9:52 am ต้องการให้ Line แสดงวันที่หมดอายุ (ฟิลด์ที่ลงท้ายด้วยตัว E)
Code: Select all
'Other code
For Each fld In rsLive.Fields
'Other code
If Right(fld.Name,1) = "E" Then
strExpireDate = fld.Value
End If
'Other code
Code: Select all
'Line Message
strMessage = "message=*Expired*" & vbNewLine & "Name : " & strUser & vbNewLine & "EXP : " & strExpireDate & vbNewLine & "Site : " & Site & vbNewLine & "Company : PTT "
ยังไม่ค่อยเข้าใจครับ รบกวนอธิบายใหม่ได้ไหมครับsnasui wrote: Thu Dec 02, 2021 11:11 am ก็ต้องหาชื่อ Field ที่มันตรงกับ Expire มันอาจจะมี Filed ที่ลงท้ายด้วย E หลาย Filed ก็อาจจะเป็นได้ อาจจะต้องตัดมาหลายอักขระแทนตัว E อักขระเดียว ฯลฯ ครับ