问题
I have a MS Access application that has a button on a form that should move files, update a field of the record and open a webpage with the following parameters: 1) the ID of the Access record 2) value of the updated field 3) secretword.
Everything works fine except opening webpage.
I've red this article:How to open a URL from MS Access with parameters and compose the line CreateObject("Shell.Application")...
FSO.MoveFolder FLD_READY & "\" & rs.Fields(order_int_ID), FLD_SERVER & "\" & rs.Fields(order_int_ID)
rs.Edit: rs.Fields(order_stage) = os07: rs.Update
CountFile = CountFile + 1
CreateObject("Shell.Application").Open "https://example.com/status/" & "/" & rs.Fields(order_int_ID) & "/" & 'os07' & "/" & 'secretword'
Could you please tell - what is wrong with it? How should I change it to get it working?
Here is the whole script. The mentioned block is almost in the end of it.
' Order_stage status
Private Const os06 = "06"
Private Const os07 = "07"
' Transfer to server
Private Const FTP_TRANSFER_TYPE_UNKNOWN As Long = 0
Private Const INTERNET_FLAG_RELOAD As Long = &H80000000
Private Const FORMAT_MESSAGE_FROM_HMODULE = &H800
Private szErrorMessage As String
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const FTP_TRANSFER_TYPE_ASCII = &H1
Private dwType As Long
Private Const FtpConnectionFile = "D:\ftp_connection.txt"
Private Const FTP_UP_HOME = "public_html/"
'Folders
Private Const FLD_READY = "d:\10-5-0-Ready"
Private Const FLD_SERVER = "d:\10-6-0-Server"
Private Sub Ctl10_50___SERVER_Click()
Dim ftpHost As String
Dim ftpPort As Long
Dim ftpUser As String
Dim ftpPassword As String
Dim CountFile As Integer
Dim hOpen As Long
Dim hConn As Long
Dim hPut As Long
Dim ftpCurrentDirectory As String
Dim szDir As String
Dim strTextLine As String
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Dim oFolder As Object
Dim oSubFolder As Object
Dim oFile As Object
Dim strFileExt As String
Dim Strt As Integer
Dim i As Integer: i = 0
Dim iFile As Integer: iFile = FreeFile
Open FtpConnectionFile For Input As #iFile
Do Until EOF(1)
Line Input #1, strTextLine
Select Case i
Case Is = 0: ftpHost = Trim(strTextLine)
Case Is = 1: ftpPort = CLng(Trim(strTextLine))
Case Is = 2: ftpUser = Trim(strTextLine)
Case Is = 3: ftpPassword = Trim(strTextLine)
Case Is = 4: Exit Do
End Select
i = i + 1
Loop
Close #iFile
hOpen = InternetOpenA("FTP Client", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
If hOpen = 0 Then
ErrorOut Err.LastDllError, "InternetOpen"
End If
dwType = FTP_TRANSFER_TYPE_ASCII
hConn = InternetConnectA(hOpen, ftpHost, ftpPort, ftpUser, ftpPassword, 1, 0, 0)
If hConn = 0 Then
ErrorOut Err.LastDllError, "InternetConnect"
End If
If (FtpCreateDirectory(hConn, FTP_UP_HOME) = False) Then
ErrorOut Err.LastDllError, "FtpCreateDirectory"
Else
End If
If (FtpSetCurrentDirectory(hConn, FTP_UP_HOME) = False) Then
ErrorOut Err.LastDllError, "FtpCreateDirectory"
Else
End If
For Each oFolder In FSO.GetFolder(FLD_CHECK).SubFolders
For Each oFile In oFolder.Files
strFileExt = FSO.GetExtensionName(oFile)
'MsgBox (strFileExt)
If strFileExt = "psd2" Then
Dim rs2 As Recordset
Set rs2 = CurrentDb.OpenRecordset("SELECT A_INCOMING_ORDERS.order_int_ID, A_INCOMING_ORDERS.order_stage FROM A_INCOMING_ORDERS WHERE (A_INCOMING_ORDERS.order_int_ID = '" & oFolder.Name & "')")
Do While Not rs2.EOF
rs2.Edit: rs2.Fields(order_stage) = os40: rs2.Update
rs2.MoveNext
Loop
rs2.Close
FSO.MoveFolder oFolder.Path, FLD_ALTER & "\" & oFolder.Name
End If
Next
Next
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("SELECT A_INCOMING_ORDERS.order_int_ID, A_INCOMING_ORDERS.order_stage FROM A_INCOMING_ORDERS WHERE (A_INCOMING_ORDERS.order_stage = '" & os06 & "');")
CountFile = 0
Do While Not rs.EOF
If (FSO.FolderExists(FLD_READY & "/" & rs.Fields(order_int_ID))) Then
If (FtpCreateDirectory(hConn, rs.Fields(order_int_ID)) = False) Then
ErrorOut Err.LastDllError, "FtpCreateDirectory"
Else
End If
For Each oFile In FSO.GetFolder(FLD_READY & "/" & rs.Fields(order_int_ID)).Files
hPut = FtpPutFileA(hConn, FLD_READY & "/" & rs.Fields(order_int_ID) & "/" & oFile.Name, "/" & FTP_UP_HOME & "/" & rs.Fields(order_int_ID) & "/" & oFile.Name, 2, 0)
If hPut = 0 Then
ErrorOut Err.LastDllError, "FtpPutFileA"
Else
End If
Next
FSO.MoveFolder FLD_READY & "\" & rs.Fields(order_int_ID), FLD_SERVER & "\" & rs.Fields(order_int_ID)
rs.Edit: rs.Fields(order_stage) = os07: rs.Update
CountFile = CountFile + 1
CreateObject("Shell.Application").Open "https://example.com/status/" & "/" & rs.Fields(order_int_ID) & "/" & 'os07' & "/" & 'secretword'
End If
rs.MoveNext
Loop
rs.Close
InternetCloseHandle hConn
InternetCloseHandle hOpen
MsgBox "Count: " & CountFile
End Sub
回答1:
Construct string by concatenating literal text with variables and constants:
CreateObject("Shell.Application").Open "https://example.com/status/%7" & rs.Fields(order_int_ID) & "%7D/%7B" & os07 & "%7D/secretword"
I don't see a declared variable or constant named secretword so instead of secretword type your actual secret word.
Above construct based on example that was in comment you have since deleted. That example not in the question so if any of the literal characters are not needed then remove them.
回答2:
The answer to this question is:
Application.FollowHyperlink "https://example.com/status/" & rs.Fields(order_int_ID) & "/" & "os07" & "/" & "secretword", , True
This solution works for me.
来源：https://stackoverflow.com/questions/48501409/how-to-generate-url-with-parameters-in-ms-access-vba-script