0

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
Kyryll S
  • 1
  • 1
  • 1
    ... and what exactly is the question? If you have a problem or a particular piece ofg code that doesn't work/that you don't know how to tackle: describe it in the question. You won't get any answers here on a question like "could you please write my code to accomplish this and that"... –  Jan 29 '18 at 13:22
  • Thanks for the note! So, the question is: How to generate URL with parameters in such MS Access vba script? – Kyryll S Jan 29 '18 at 13:54
  • You have +60 lines of code and a complicated intro. If the question is really "How do I generate an URL in VBA?" THe answer is: create a string and put the URL in it. Please put some time into asking your question, so that the helpers don't have to work overtime (or mind read) to help you. Everyone here loves to help. But we're not here to solve unnecessary riddles. –  Jan 29 '18 at 14:34
  • Ok... Let's divide the question... Could you please tell how that string to generate URL with parameters should look like? Please understand: I am not a programmer. My programmer is not available at the moment and I need this change in accounting system asap. So, please help me if you can. I think this string should be inserted in the bottom (almost) of the script. – Kyryll S Jan 29 '18 at 14:53
  • *Would be very grateful for any help!* ...help with what? You posted a block of code but provide no issues, errors, undesired results. Please edit accordingly (see edit link below tags) and not in comments here. – Parfait Jan 29 '18 at 16:38
  • I have rewrote the question. Please see. – Kyryll S Jan 29 '18 at 19:10

2 Answers2

0

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.

June7
  • 19,874
  • 8
  • 24
  • 34
  • Thank you very much. The string in question is this: CreateObject("Shell.Application").Open "https://example.com/status/" & "/" & rs.Fields(order_int_ID) & "/" & 'os07' & "/" & 'secretword' – Kyryll S Jan 29 '18 at 19:47
  • That is just the code from your question, not what the output string should look like and it makes no sense as example of output. `os07` is a declared variable. If you want the value of `os07` then must concatenate the variable, not the literal string **os07**, just as you have concatenated the recordset field because that is a variable input. Also, the "/" after `status/` produces a doubled slash in the output - do you really want that? – June7 Jan 29 '18 at 19:57
0

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.

Kyryll S
  • 1
  • 1