Solved Download a file and store in a folder on click (1 Viewer)

5hadow

Member
Local time
Today, 18:08
Joined
Apr 26, 2021
Messages
57
Hello all,

I have decided to make a dedicated post since I had this as a part of another thread Here.

Basically I need to click on a button and download a file based on URL from a txt box, and place it in folder based on fields. Here is what I have so far:

Code:
Dim objHTTP As Object
Dim FileByte() As Byte
Dim strFile As String
Dim intFile As Integer
Dim URL As String

URL = Forms!frmWIDetail!txtDoc
MsgBox "Your file is " & URL & ""
intFile = Forms!frmWIDetail!txtDoc.Value()
strFile = Mid(URL, InStrRev(URL, "/") + 1)

Set objHTTP = CreateObject("Microsoft.XMLHTTP")

With objHTTP
    .Open "GET", URL, False
    .Send
    If .Status = 200 Then
        FileByte = .responseBody
    End If
End With

Open strFolder & strSerial & "\" & strFile For Binary Lock Read Write As #intFile
    Put #intFile, , FileByte
Close #intFile

Set objHTTP = Nothing

I'm not getting anything with this.

First part of code (Copy another two files and place them in the same directory) unrelated to this issue:
Code:
Public Sub btnGenerate_Click()
    Const strParent = "M:\429 QMO\Document Reviews\Document Reviews\"
    Dim strSerial As String
    Dim strSFolder As String
    Dim strFolder As String
    Dim fso As Object
    Dim FDate As String
    Dim Path As String
    Dim TRevChk As String
    Dim TPriAss As String
    Dim TRevChkNew As String
    Dim TRevChkOld As String
    
    TRevChk = Forms!frmConfig!fileTRevChk.Value
    TPriAss = Forms!frmConfig!fileTPriAss.Value
    Path = strParent & Me.fldSerial
    FDate = Format(Now, "yyyy")
    strSFolder = strParent & FDate & "\"
    strFolder = strParent & FDate
    strSerial = Me.fldSerial
    TRevChkOld = Path & "\" & "DND 4719-E WI Review Checklist.pdf"
    TRevChkNew = Path & "\" & "DND 4719-E WI Review Checklist " & "-" & " " & strSerial & ".pdf"
    Set fso = VBA.CreateObject("Scripting.FileSystemObject")
    
    On Error Resume Next
    If FolderExists(strFolder) = False Then
        fso.CreateFolder strFolder
    End If
    If fso.FolderExists(strSFolder & strSerial) = False Then
        fso.CreateFolder strSFolder & strSerial
        Call fso.CopyFile(TRevChk, strSFolder & strSerial & "\" & fso.GetBaseName(TRevChk) & " - " & strSerial & "." & fso.GetExtensionName(TRevChk), no)
        Call fso.CopyFile(TPriAss, strSFolder & strSerial & "\" & fso.GetBaseName(TPriAss) & " - " & strSerial & "." & fso.GetExtensionName(TPriAss), no)
    Else
        Call fso.CopyFile(TRevChk, strSFolder & strSerial & "\" & fso.GetBaseName(TRevChk) & " - " & strSerial & "." & fso.GetExtensionName(TRevChk), no)
        Call fso.CopyFile(TPriAss, strSFolder & strSerial & "\" & fso.GetBaseName(TPriAss) & " - " & strSerial & "." & fso.GetExtensionName(TPriAss), no)
    End If
    Me.txtFolder.Value = Path
 

theDBguy

I’m here to help
Staff member
Local time
Today, 15:08
Joined
Oct 29, 2018
Messages
17,137
Hello all,

I have decided to make a dedicated post since I had this as a part of another thread Here.

Basically I need to click on a button and download a file based on URL from a txt box, and place it in folder based on fields. Here is what I have so far:

Code:
Dim objHTTP As Object
Dim FileByte() As Byte
Dim strFile As String
Dim intFile As Integer
Dim URL As String

URL = Forms!frmWIDetail!txtDoc
MsgBox "Your file is " & URL & ""
intFile = Forms!frmWIDetail!txtDoc.Value()
strFile = Mid(URL, InStrRev(URL, "/") + 1)

Set objHTTP = CreateObject("Microsoft.XMLHTTP")

With objHTTP
    .Open "GET", URL, False
    .Send
    If .Status = 200 Then
        FileByte = .responseBody
    End If
End With

Open strFolder & strSerial & "\" & strFile For Binary Lock Read Write As #intFile
    Put #intFile, , FileByte
Close #intFile

Set objHTTP = Nothing

I'm not getting anything with this.

First part of code (Copy another two files and place them in the same directory) unrelated to this issue:
Code:
Public Sub btnGenerate_Click()
    Const strParent = "M:\429 QMO\Document Reviews\Document Reviews\"
    Dim strSerial As String
    Dim strSFolder As String
    Dim strFolder As String
    Dim fso As Object
    Dim FDate As String
    Dim Path As String
    Dim TRevChk As String
    Dim TPriAss As String
    Dim TRevChkNew As String
    Dim TRevChkOld As String
 
    TRevChk = Forms!frmConfig!fileTRevChk.Value
    TPriAss = Forms!frmConfig!fileTPriAss.Value
    Path = strParent & Me.fldSerial
    FDate = Format(Now, "yyyy")
    strSFolder = strParent & FDate & "\"
    strFolder = strParent & FDate
    strSerial = Me.fldSerial
    TRevChkOld = Path & "\" & "DND 4719-E WI Review Checklist.pdf"
    TRevChkNew = Path & "\" & "DND 4719-E WI Review Checklist " & "-" & " " & strSerial & ".pdf"
    Set fso = VBA.CreateObject("Scripting.FileSystemObject")
 
    On Error Resume Next
    If FolderExists(strFolder) = False Then
        fso.CreateFolder strFolder
    End If
    If fso.FolderExists(strSFolder & strSerial) = False Then
        fso.CreateFolder strSFolder & strSerial
        Call fso.CopyFile(TRevChk, strSFolder & strSerial & "\" & fso.GetBaseName(TRevChk) & " - " & strSerial & "." & fso.GetExtensionName(TRevChk), no)
        Call fso.CopyFile(TPriAss, strSFolder & strSerial & "\" & fso.GetBaseName(TPriAss) & " - " & strSerial & "." & fso.GetExtensionName(TPriAss), no)
    Else
        Call fso.CopyFile(TRevChk, strSFolder & strSerial & "\" & fso.GetBaseName(TRevChk) & " - " & strSerial & "." & fso.GetExtensionName(TRevChk), no)
        Call fso.CopyFile(TPriAss, strSFolder & strSerial & "\" & fso.GetBaseName(TPriAss) & " - " & strSerial & "." & fso.GetExtensionName(TPriAss), no)
    End If
    Me.txtFolder.Value = Path
Hi. It's common courtesy to give attribution to the original author if you are using someone else's code. Please leave all the comments included in the code wherever you got it from.

When you say you're not getting anything, were you not getting an error message either?

I see you have this line:
Code:
Open strFolder & strSerial & "\" & strFile For Binary Lock Read Write As #intFile
But I don't see where you declared and assigned a value to the variables strFolder and strSerial.
 

5hadow

Member
Local time
Today, 18:08
Joined
Apr 26, 2021
Messages
57
Hi. It's common courtesy to give attribution to the original author if you are using someone else's code. Please leave all the comments included in the code wherever you got it from.

When you say you're not getting anything, were you not getting an error message either?

I see you have this line:
Code:
Open strFolder & strSerial & "\" & strFile For Binary Lock Read Write As #intFile
But I don't see where you declared and assigned a value to the variables strFolder and strSerial.
Ok, will consider that next time, my apologies.

Code:
    strSFolder = strParent & FDate & "\"

    strSerial = Me.fldSerial

    FDate = Format(Now, "yyyy")

    Const strParent = "M:\429 QMO\Document Reviews\Document Reviews\"
Those are in the code above.
 

5hadow

Member
Local time
Today, 18:08
Joined
Apr 26, 2021
Messages
57
I get "Type Mismatch" on following line:

intFile = Forms!frmWIDetail!txtDoc.Value()
 

theDBguy

I’m here to help
Staff member
Local time
Today, 15:08
Joined
Oct 29, 2018
Messages
17,137
Those are in the code above.
But it is not clear where they sit in your entire code. Can you please post the entire code exactly as you have them in your db? The way you posted it, it looks like they are separate, or at least the first one is placed before the second one, which would mean those variables are still empty at the you tried to use them.
 

theDBguy

I’m here to help
Staff member
Local time
Today, 15:08
Joined
Oct 29, 2018
Messages
17,137
I get "Type Mismatch" on following line:

intFile = Forms!frmWIDetail!txtDoc.Value()
You weren't supposed to change that line from the original code, which was this:
Code:
intFile = FreeFile()
 

5hadow

Member
Local time
Today, 18:08
Joined
Apr 26, 2021
Messages
57
You weren't supposed to change that line from the original code, which was this:
Code:
intFile = FreeFile()
That's right!
I've dug around and I've noticed that in original code. Not sure how I messed it up.
Second, on my Open strFolder & strSerial & "\" & strFile For Binary Lock Read Write As #intFile line, "strFolder" was supposed to be "strSFolder".

It all works now. Thanks!

By the way, the credit for the code as above:

theDBguy's Access Blog: Download a File from the Internet

'thedbguy@gmail.com
'3/5/2021
 

Gasman

Enthusiastic Amateur
Local time
Today, 23:08
Joined
Sep 21, 2011
Messages
9,297
Yes, the person who still helped you, despite you removing the credits?
 
Last edited:

theDBguy

I’m here to help
Staff member
Local time
Today, 15:08
Joined
Oct 29, 2018
Messages
17,137
That's right!
I've dug around and I've noticed that in original code. Not sure how I messed it up.
Second, on my Open strFolder & strSerial & "\" & strFile For Binary Lock Read Write As #intFile line, "strFolder" was supposed to be "strSFolder".

It all works now. Thanks!

By the way, the credit for the code as above:

theDBguy's Access Blog: Download a File from the Internet

'thedbguy@gmail.com
'3/5/2021
Hi. Glad to hear you got it sorted out.

Hopefully, no one would publish a piece of code if it doesn't work. At least, I try not to. So, if you're not sure how to modify something you pulled from the Internet, feel free to ask us for help or clarification. We'll be happy to assist.

Good luck with your project.
 

Users who are viewing this thread

Top Bottom