Open Save pdf Link

**tome10** · Jul 23rd, 2011, 11:46 AM

Is there a way to deal with a this link's ending?
Sometimes like this: "_Route_ecd.pdf"
Sometimes like this: "_ECD.pdf"

Code:

lngOpenPage = ShellExecute(Application.hwnd, "Open", "http://eic.vzbi.com/EIC_DRW/" & TextBox1.Text & "_Route_ecd.pdf", 0&, 0&, 0&)

Also, when I open these PDF's do they download automatically in the temp folder?
Maybe I could have it look there for the PDF to start with (Available Offline).
Could I have a Macro Download the PDF to somewhere I specify, and then it be available Offline?

**westconn1** · Jul 23rd, 2011, 06:49 PM

Also, when I open these PDF's do they download automatically in the temp folder?

instead of opening, download the file then open the saved file
use urldownloadtofile API, to save to local disk

Is there a way to deal with a this link's ending?

using the above API you can test for success with first ending, if not success, try second ending

**tome10** · Jul 24th, 2011, 06:55 PM

I grabbed this code from here
http://www.vbforums.com/showthread.p...loadtofile+API

They were talking about a Progress Bar. I don't need a progress bar, but I think the rest is what I need.
My links are bad for some reason in the new code.

Code:

    Option Explicit
    Private Declare Function DoFileDownload Lib "shdocvw.dll" (ByVal lpszFile As String) As Long
    Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
        Dim retVal As Long
        Dim theUrl As String
        Dim savePath As String
        Dim pathExist As Long
        
'    OLD Option Explicit
'
'        Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
'        (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
'        ByVal lpParameters As String, ByVal lpDirectory As String, _
'        ByVal nShowCmd As Long) As Long



    Private Sub CommandButton1_Click()
    
        If CheckBox1.Value = True Then
            theUrl = "http://eic.mmci.com/eic_drw/qr/" & TextBox1.Text & "/" & TextBox1.Text & "_SPEC.pdf", 0&, 0&, 0&)
            If theUrl = "" Then Exit Sub
            
            savePath = App.Path + "/w3index.html" 'C:\Documents and Settings\username\My Documents\ECD's
            If savePath = "" Then Exit Sub
            
            retVal = URLDownloadToFile(0, theUrl, savePath, 0, 0)
        
            If retVal = 0 Then
            MsgBox "success"
            Else
            MsgBox "failed"
        End If
        If CheckBox2.Value = True Then
            theUrl = "http://eic.mmci.com/EIC_DRW/" & TextBox1.Text & "_Route_ecd.pdf", 0&, 0&, 0&)
              If theUrl = "" Then
            
            theUrl = "http://eic.mmci.com/EIC_DRW/" & TextBox1.Text & "_ECD.pdf", 0&, 0&, 0&)
               If theUrl = "" Then Exit Sub
            
            savePath = App.Path + "/w3index.html" 'C:\Documents and Settings\username\My Documents\ECD's
              If savePath = "" Then Exit Sub
            
            retVal = URLDownloadToFile(0, theUrl, savePath, 0, 0)
        
            If retVal = 0 Then
            MsgBox "success"
            Else
            MsgBox "failed"
            End If
            
            
        End Sub
        'OLD CODE
'        Dim lngOpenPage As Long
'        If CheckBox1.Value = True Then
'        lngOpenPage = ShellExecute(Application.hwnd, "Open", "http://eic.mmci.com/eic_drw/qr/" & TextBox1.Text & "/" & TextBox1.Text & "_SPEC.pdf", 0&, 0&, 0&)
'        End If
'        If CheckBox2.Value = True Then
'        lngOpenPage = ShellExecute(Application.hwnd, "Open", "http://eic.mmci.com/EIC_DRW/" & TextBox1.Text & "_Route_ecd.pdf", 0&, 0&, 0&)
'        End If
    'End Sub

**westconn1** · Jul 25th, 2011, 04:32 AM

you do not need the other parameters you were using for shellexecute

theUrl = "http://eic.mmci.com/EIC_DRW/" & TextBox1.Text & "_ECD.pdf", 0&, 0&, 0&)

should give error
you only need

Code:

theUrl = "http://eic.mmci.com/EIC_DRW/" & TextBox1.Text & "_ECD.pdf"

**tome10** · Jul 25th, 2011, 03:39 PM

I've got a lot of if statements. I can't keep track of where the Ends should be.

Code:

    Private Sub CommandButton1_Click()
    
        If CheckBox1.Value = True Then
            theUrl = "http://eic.mmci.com/eic_drw/qr/" & TextBox1.Text & "/" & TextBox1.Text & "_SPEC.pdf"
            If theUrl = "" Then
            theUrl = "http://eic.mmci.com/eic_drw/qr/" & TextBox1.Text
            If theUrl = "" Then Exit Sub
            savePath = "C:\Documents and Settings\username\My Documents\ECD's"
            If savePath = "" Then Exit Sub

            retVal = URLDownloadToFile(0, theUrl, savePath, 0, 0)

            If retVal = 0 Then
            MsgBox "success"
            Else
            MsgBox "failed"
        End If
        If CheckBox2.Value = True Then
            theUrl = "http://eic.mmci.com/EIC_DRW/" & TextBox1.Text & "_Route_ecd.pdf"
            If theUrl = "" Then
            theUrl = "http://eic.mmci.com/EIC_DRW/" & TextBox1.Text & "_ECD.pdf"
            If theUrl = "" Then Exit Sub

            savePath = "C:\Documents and Settings\username\My Documents\ECD's"
            If savePath = "" Then Exit Sub

            retVal = URLDownloadToFile(0, theUrl, savePath, 0, 0)

            If retVal = 0 Then
            MsgBox "success"
            Else
            MsgBox "failed"
            End If


        End Sub

**tome10** · Jul 25th, 2011, 04:24 PM

It comes back with path doesn't exist. I thought maybe because I have to sign in to go to the link, but I changed to Google, and it still does it. Error -2147467260 in the watch window.

Code:

    Option Explicit
    Private Declare Function DoFileDownload Lib "shdocvw.dll" (ByVal lpszFile As String) As Long
    Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
        Dim retVal As Long
        Dim theUrl As String
        Dim savePath As String
        Dim pathExist As Long
       
    Private Sub Commandbutton1_Click()
    
        'If CheckBox1.Value = True Then
            theUrl = "http://www.google.com"
            If theUrl = "" Then
            End If
            theUrl = "http://www.google.com"
            If theUrl = "" Then Exit Sub
            savePath = "C:\Documents and Settings\username\My Documents\ECD's"
            If savePath = "" Then Exit Sub

            retVal = URLDownloadToFile(0, theUrl, savePath, 0, 0)

            If retVal = 0 Then
            MsgBox "success"
            Else
            MsgBox "failed"
            End If
    
        'If CheckBox2.Value = True Then
            theUrl = "http://www.google.com"
            If theUrl = "" Then
            End If
            theUrl = "http://www.google.com"
            
            If theUrl = "" Then Exit Sub

            savePath = "C:\Documents and Settings\username\My Documents\ECD's"
            If savePath = "" Then Exit Sub

            retVal = URLDownloadToFile(0, theUrl, savePath, 0, 0)
        
        If retVal = 0 Then
            MsgBox "success"
            Else
            MsgBox "failed"
            End If
        

        End Sub

**westconn1** · Jul 25th, 2011, 04:31 PM

better code fromatting (indenting) would help
try like

vb Code:

Private Sub CommandButton1_Click()
        savePath = "C:\Documents and Settings\username\My Documents\ECD's"
        if len(dir(savepath, vbdirectory)) = 0 then exit sub  ' test if savepath exists, some message should be shown if it does not
        If CheckBox1.Value = True Then
            theUrl = "http://eic.mmci.com/eic_drw/qr/" & TextBox1.Text & "/" & TextBox1.Text & "_SPEC.pdf"
            If theUrl = "" Then   'pointless as no test is made
            theUrl = "http://eic.mmci.com/eic_drw/qr/" & TextBox1.Text
            If theUrl = "" Then Exit Sub    ' same here
 
 
            retval = URLDownloadToFile(0, theUrl, savePath, 0, 0)
 
            If retval = 0 Then
                MsgBox "success"
                Else
                MsgBox "failed"
            End If
        End If
        If CheckBox2.Value = True Then
            theUrl = "http://eic.mmci.com/EIC_DRW/" & TextBox1.Text & "_Route_ecd.pdf"
            retval = URLDownloadToFile(0, theUrl, savePath, 0, 0)
            If Not retval = 0 Then   ' if download fails try second option
                theUrl = "http://eic.mmci.com/EIC_DRW/" & TextBox1.Text & "_ECD.pdf"
                retval = URLDownloadToFile(0, theUrl, savePath, 0, 0)
                If retval = 0 Then
                    MsgBox "success"
                    Else
                    MsgBox "failed"
                End If
                Else
                MsgBox "success"
            End If
        End If
 
        End Sub

unless you test your strings for validity, it is pointless to test for empty immediately after they have had values assigned, also you should define all variables

**tome10** · Jul 25th, 2011, 05:41 PM

unless you test your strings for validity, it is pointless to test for empty immediately after they have had values assigned.

If theUrl = "" Then 'pointless as no test is made

I thought it was looking at the link 'before click' and somehow seeing if the link is valid. Is that even Possible?

also you should define all variables

What variables are you referring? I have no idea..

**tome10** · Jul 25th, 2011, 06:51 PM

It Fails with the 2147467260 number.
When I click on one of these links, I have to put in a username and password in order to access the site. Could that be messing it up?
Re-Boot..
How do I at least make it open the link like the old Shell Execute did?
The change I want to do is to download the file and have it locally.
I need it to search locally for the file in MyDocuments, and if it doesn't find it, it needs to look remotely with the links.
When I visit a new URL I need it to download to MyDocuments for future use.
As of now, it's hard to tell what's wrong with it.

Code:

        Private Sub CommandButton1_Click()
            savePath = "C:\Documents and Settings\user.name\My Documents\ECD's"
            If Len(Dir(savePath, vbDirectory)) = 0 Then Exit Sub  ' test if savepath exists, some message should be shown if it does not
            'If CheckBox1.Value = True Then
                theUrl = "http://eic.mmci.com/eic_drw/qr/" & "059969-501" & "/" & "059969-501" & "_SPEC.pdf"
                'If theUrl = "" Then   'pointless as no test is made
                theUrl = "http://eic.mmci.com/eic_drw/qr/" & "059969-501"
                If theUrl = "" Then Exit Sub    ' same here
                
                retVal = URLDownloadToFile(0, theUrl, savePath, 0, 0)
                
                If retVal = 0 Then
                    MsgBox "success"
                    Else
                    MsgBox "failed"
                End If
            'End If
            'If CheckBox2.Value = True Then
                theUrl = "http://eic.mmci.com/EIC_DRW/" & "059969-501" & "_Route_ecd.pdf"
                retVal = URLDownloadToFile(0, theUrl, savePath, 0, 0)
                If Not retVal = 0 Then   ' if download fails try second option
                    theUrl = "http://eic.mmci.com/EIC_DRW/" & "059969-501" & "_ECD.pdf"
                    retVal = URLDownloadToFile(0, theUrl, savePath, 0, 0)
                    If retVal = 0 Then
                        MsgBox "success"
                        Else
                        MsgBox "failed"
                    End If
                    Else
                    MsgBox "success"
                End If
            'End If
            'End If
        End Sub

**westconn1** · Jul 26th, 2011, 04:13 AM

I have to put in a username and password in order to access the site. Could that be messing it up?

probably, but i would have thought it would also affect the shellexecute

**tome10** · Jul 26th, 2011, 10:50 AM

Well, it's kinda transparent. You click the link, and the proxy server interupts you as asks for your username and pasword. That's when you go to the link.. It may prevent trying to just Download something. If that's what this is trying to do.
So, I at least need this to activate the link like the shell execute did. What do I need to change?

**tome10** · Jul 27th, 2011, 11:26 PM

I've tried about 6 different codes, and I can't get anything to download, or open. What is a HTTP Request Class?

**tome10** · Jul 28th, 2011, 12:02 AM

I found this that brings back the response of the Link. Can this be converted to do what I need?

Code:

        Public PageSource As String
        Public httpRequest As Object
        
        Function GetURLStatus(ByVal URL As String, Optional AllowRedirects As Boolean)
        
          Const WinHttpRequestOption_UserAgentString = 0
          Const WinHttpRequestOption_EnableRedirects = 6
          
          
            On Error Resume Next
               Set httpRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
                 If httpRequest Is Nothing Then
                    Set httpRequest = CreateObject("WinHttp.WinHttpRequest.5")
                 End If
               Err.Clear
            On Error GoTo 0
        
            httpRequest.Option(WinHttpRequestOption_UserAgentString) = "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 6.0)"
            httpRequest.Option(WinHttpRequestOption_EnableRedirects) = AllowRedirects
        
        
          'Clear any pervious web page source information
            PageSource = ""
            
                'Add protocol if missing
                  If InStr(1, URL, "://") = 0 Then
                     URL = "http://" & URL
                  End If
        
                  'Launch the HTTP httpRequest synchronously
                    On Error Resume Next
                      httpRequest.Open "GET", URL, False
                      If Err.Number <> 0 Then
                        'Handle connection errors
                          GetURLStatus = Err.Description
                          Err.Clear
                          Exit Function
                      End If
                    On Error GoTo 0
                   
                  'Send the http httpRequest for server status
                    On Error Resume Next
                      httpRequest.Send
                      httpRequest.WaitForResponse
                      If Err.Number <> 0 Then
                        ' Handle server errors
                          PageSource = "Error"
                          GetURLStatus = Err.Description
                          Err.Clear
                      Else
                        'Show HTTP response info
                          GetURLStatus = httpRequest.Status & " - " & httpRequest.StatusText
                        'Save the web page text
                          PageSource = httpRequest.responsetext
                      End If
                    On Error GoTo 0
                    
        End Function
        
        Sub GetPageSource()
        
          Dim Status As String
          Dim Text As String
            'Status = GetURLStatus = httpRequest.responsetext
            Status = GetURLStatus(URL:="http://www.google.com", AllowRedirects:=True)
            Text = PageSource
                 
        End Sub

**tome10** · Jul 28th, 2011, 08:11 AM

This errors on File Exists. Sub or Function not defined. What does that mean?
If File_Exists(sFile) = True Then

Code:

        sFile = "c:\ECDs\059969-501_SPEC"
            If File_Exists(sFile) = True Then
            MsgBox sFile & " exist"
            Else
            MsgBox sFile & " does not exist"
            End If

**tome10** · Jul 28th, 2011, 08:30 AM

This works to see if local file exists.

Code:

            Sub test()
            Dim strfullname As String

            strfullname = "c:\ECDs\059969-501_SPEC.pdf"
            If FileExists(strfullname) Then
                MsgBox "Its there, OK!"
            Else
                MsgBox "No sign of it!"
            End If

            End Sub


            Function FileExists(strfullname As String) As Boolean
            FileExists = Dir(strfullname) <> ""
            End Function

**tome10** · Jul 28th, 2011, 12:50 PM

Alright, I signed in behind the firewall, and ran the Response Code below,and it came back with:

: GetURLStatus : "302 - Moved Temporarily" : Variant/String

This is the point at which your re-directed to sign in.
So, can I change something in the code below to launch a browser and go to the link? Like the Shell Execute did?
I guess the objective is to:
1) Check Locally for file
2) Launch Browser to Link
3) Set Save path
4) Save Object Manually if not Auto.

Code:

          'Response Code
        Public PageSource As String
        Public httpRequest As Object
        
        Function GetURLStatus(ByVal URL As String, Optional AllowRedirects As Boolean)
        
          Const WinHttpRequestOption_UserAgentString = 0
          Const WinHttpRequestOption_EnableRedirects = 6
          
          
            On Error Resume Next
               Set httpRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
                 If httpRequest Is Nothing Then
                    Set httpRequest = CreateObject("WinHttp.WinHttpRequest.5")
                 End If
               Err.Clear
            On Error GoTo 0
        
            httpRequest.Option(WinHttpRequestOption_UserAgentString) = "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 6.0)"
            httpRequest.Option(WinHttpRequestOption_EnableRedirects) = AllowRedirects
        
        
          'Clear any pervious web page source information
            PageSource = ""
            
                'Add protocol if missing
                  If InStr(1, URL, "://") = 0 Then
                     URL = "http://" & URL
                  End If
        
                  'Launch the HTTP httpRequest synchronously
                    On Error Resume Next
                      httpRequest.Open "GET", URL, False
                      If Err.Number <> 0 Then
                        'Handle connection errors
                          GetURLStatus = Err.Description
                          Err.Clear
                          Exit Function
                      End If
                    On Error GoTo 0
                   
                  'Send the http httpRequest for server status
                    On Error Resume Next
                      httpRequest.Send
                      httpRequest.WaitForResponse
                      If Err.Number <> 0 Then
                        ' Handle server errors
                          PageSource = "Error"
                          GetURLStatus = Err.Description
                          Err.Clear
                      Else
                        'Show HTTP response info
                          GetURLStatus = httpRequest.Status & " - " & httpRequest.StatusText
                        'Save the web page text
                          PageSource = httpRequest.responsetext
                      End If
                    On Error GoTo 0
                    
        End Function
        
        Sub GetPageSource()
        
          Dim Status As String
          Dim Text As String
            'Status = GetURLStatus = httpRequest.responsetext
            Status = GetURLStatus(URL:="http://www.google.com", AllowRedirects:=True)
            Text = PageSource
                 
        End Sub

**tome10** · Jul 28th, 2011, 11:39 PM

This is the link during the security check thing. When I put this link in the return response code, it comes back "200 - ok", so worse case I just use this long link. Unless all those characters are randomly generated.

https://login.mycompany.com/siteminderagent/forms/login.jsp?TYPE=33554433&REALMOID=06-0b7088cd-8de9-107c-b0c8-85114dc6fd9c&GUID=&SMAUTHREASON=0&METHOD=GET&SMAGENTNAME=$SM$Kftvj3GWODhjaKc3gEGJ%2fYoK1d6onbdIV gmbcUtvOu0cHOaXN9MXITtASHZ59ghj&TARGET=$SM$HTTP%3a%2f%2feic%2emmci%2ecom%2feic_drw%2fqr%2f059966-500%2f059966-500_SPEC%2epdf

I found this here: http://www.vbforums.com/showthread.p...+http+download
can this password code work?

Code:

Screen.MousePointer = vbHourglass 

Inet1.URL = "http://username:[email protected]" 
'Inet1.UserName = "myuser" 
'Inet1.Password = "mypass" 
'Inet1.Protocol = icFTP 
Inet1.Execute Inet1.URL, "get /myfolder/myfile.txt c:\myfile.txt " 

Do While Inet1.StillExecuting 
DoEvents 
Loop 

Screen.MousePointer = vbDefault

or this ?

Code:

Inet1.URL = "http://username:[email protected]/myfolder/myfile.txt"

**westconn1** · Jul 29th, 2011, 05:36 AM

can this password code work?

depends on the website
you may also be able include the username and password in the url to download the file, without using an inet control

**tome10** · Jul 29th, 2011, 07:34 AM

I don't know what an Inet control is.

What exactly would I put here? I don't get how the link is worded.

Code:

Inet1.Execute Inet1.URL, "get /myfolder/myfile.txt c:\myfile.txt "

Code:

        Inet1.URL = "http://username:password@https://login.mycompany.com/siteminderagent/forms/login.jsp?TYPE=33554433&REALMOID=06-0b7088cd-8de9-107c-b0c8-85114dc6fd9c&GUID=&SMAUTHREASON=0&METHOD=GET&SMAGENTNAME=$SM$Kftvj3GWODhjaKc3gEGJ&#37;2fYoK1d6onbdIVgmbcUtvOu0cHOaXN9MXITtASHZ59ghj&TARGET=$SM$HTTP%3a%2f%2feic%2evzbi%2ecom%2feic_drw%2fqr%2f059966-500%2f059966-500_SPEC%2epdf"
        Inet1.UserName = "Username"
        Inet1.Password = "Password"
        Inet1.Protocol = icFTP
        Inet1.Execute Inet1.URL, "get /myfolder/myfile.txt c:\myfile.txt "

**tome10** · Jul 29th, 2011, 08:11 AM

Can you take a look at this west?
http://www.codeproject.com/KB/IP/Sit...ebRequest.aspx

**westconn1** · Jul 30th, 2011, 03:28 AM

I don't know what an Inet control is.

the code posted is for an inet control (inet1), you would need to add an inet control to a form or worksheet

i believe, using get with an inet control is for a ftp server, rather than a web server, i use other methods to do FTP file transfers as i do not like the inet control particularly

i am not familiar with the code linked to in the last post

post or pm me a link to the actual download file, including login and password if you want me to try to give a working solution

**tome10** · Jul 31st, 2011, 12:23 AM

West, you have to be on the Corporate VPN in order for the links to work, so I don't think having all my login info would help anyways.

Square 1:
Obviously the get direct won't work unless I find some super smart web developer familiar with this Siteminder Agent thing.
I don't mind signing in. So that isn't a big deal.

So, I need a way to look at my local files and see if "059969-501_SPEC" is there, and if not launch a web browser and go to a link. Can Shell Execute do that? Can the code in post 16 do that?
Do you know of any way to do that?
Problems:
1)The ending of the files on the Server are different occasionally. ex 059969-501_ECD, 059969-501_ROUTE_ecd
2)Sometimes the files are .pdf, and sometimes they are Vizio .vsd. so can the look local only look at the name and not the file type?

**westconn1** · Jul 31st, 2011, 05:10 AM

Can Shell Execute do that?

use dir to find if file exists local first

vb Code:

mypath = "c\test\"    ' change to suit
fname = dir(mypath & "059969-501_SPEC*.*")
if len(fname) > 0 then 
       ' shellexecute mypath & fname
  else
       ' find file from server and display
end if

do you have FTP access to the server? if so all is simple

**tome10** · Jul 31st, 2011, 12:33 PM

do you have FTP access to the server? if so all is simple

I don't know. I couldn't figure out how to post a screenshot, but the page looks like this if you just go to the link w/out the proj number on the end.
it looks FTP to me, but i'm not totally sure the difference between HTTP and FTP.

[To Parent Directory]
Friday, April 08, 2011 4:13 PM <dir> 000140-004
Tuesday, April 12, 2011 7:07 PM <dir> 000140-005
Thursday, June 23, 2011 5:00 PM <dir> 040475-001
Wednesday, May 30, 2007 10:11 PM <dir> 040887-074
Thursday, July 07, 2011 10:44 AM <dir> 040887-075FA_spec
Tuesday, June 28, 2011 2:10 PM <dir> 040887-076
Wednesday, April 20, 2011 10:51 AM <dir> 040887-077FA
Wednesday, May 30, 2007 10:03 PM <dir> 040887-078_FAspec
Wednesday, April 13, 2011 3:45 PM <dir> 040887-079FA_spec
Wednesday, May 30, 2007 9:51 PM <dir> 040887-080 FA
Wednesday, May 30, 2007 9:48 PM <dir> 040887-081
Monday, April 11, 2011 7:03 PM <dir> 040887-082

**tome10** · Jul 31st, 2011, 08:56 PM

This actually works.. Is there a way to set the path to save as? Or even better, after the page is open just save by it's self?

Code:

Private Declare Function ShellExecute _
    Lib "shell32.dll" _
    Alias "ShellExecuteA" ( _
    ByVal hwnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) _
    As Long
 

    
    Sub CommandButton1_click()
            
            Dim strFile As String
            Dim strAction As String
            Dim lngErr As Long
            
            mypath = "C:\Documents and Settings\My Documents\ECDs\"
            fname = Dir(mypath & TextBox1.Text & "_SPEC.pdf")
        If CheckBox1.Value = True Then
                If Len(fname) > 0 Then
            
                strFile = "C:\Documents and Settings\My Documents\ECDs\" & TextBox1.Text & "_SPEC.pdf"
                strAction = "OPEN"
                lngErr = ShellExecute(0, strAction, strFile, "", "", 0)
        
                Else
                    ' find file from server and display

                strFile = "http://eic.mmci.com/eic_drw/qr/" & TextBox1.Text & "/" & TextBox1.Text & "_SPEC.pdf"
                strAction = "open"
                lngErr = ShellExecute(0, strAction, strFile, "", "", 0)
                End If
        End If
    End Sub

**tome10** · Jul 31st, 2011, 11:48 PM

I tried being slick, and combine the Go code with the URLDownloadtoFile code you gave me a while back. I figured 1)i'm already signed in, and 2)the url is valid now. But it doesn't work. Comes back with -2147467260 "transfer aborted".

I combined the 2 private Declares. Not sure if I did it right, but it isn't erroring.

Code:

Private Declare Function URLDownloadToFileA Lib "urlmon" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, _
ByVal lpfnCB As Long) As Long
Private Declare Function ShellExecute _
    Lib "shell32.dll" _
    Alias "ShellExecuteA" ( _
    ByVal hwnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) _
    As Long


Public Function DownloadFile(ByVal url As String, LocalFilename As String) As Boolean
    Dim lngRetVal As Long
    lngRetVal = URLDownloadToFileA(0, url, LocalFilename, 0, 0)
    If lngRetVal = 0 Then DownloadFile = True
End Function


 

    
    Sub CommandButton1_click()
            
            Dim strFile As String
            Dim strAction As String
            Dim lngErr As Long
            
            mypath = "C:\Documents and Settings\My Documents\ECDs\"
            fname = Dir(mypath & TextBox1.Text & "_SPEC.pdf")
        If CheckBox1.Value = True Then
                If Len(fname) > 0 Then
            
                strFile = "C:\Documents and Settings\My Documents\ECDs\" & TextBox1.Text & "_SPEC.pdf"
                strAction = "OPEN"
                lngErr = ShellExecute(0, strAction, strFile, "", "", 0)
        
                Else
                    ' find file from server and display

                strFile = "http://eic.mmci.com/eic_drw/qr/" & TextBox1.Text & "/" & TextBox1.Text & "_SPEC.pdf"
                strAction = "open"
                lngErr = ShellExecute(0, strAction, strFile, "", "", 0)
                
                FileURL = strFile
                DownloadFile FileURL, "C:\Documents and Settings\My Documents\ECDs\"                End If
                
        End If
    End Sub

**westconn1** · Aug 1st, 2011, 05:56 AM

i would assume that if the file opens using shellexecute, it should be in the internet explorer cache, therefore it may be possible to save the file from the cache entry

**tome10** · Aug 1st, 2011, 08:42 AM

I found this.

Code:

Public Sub DownloadFile()
On Error GoTo errHere
 
Dim strQRY As String
 
Dim strHTTP As String
Dim strFileToSave As String
 
strHTTP = "File To Download HTTP Address"
strFileToSave = "Full_Path_And_File_Name_To_Save"
 
If fnDownloadHTTP(strHTTP, strFileToSave) = False Then      ' -- downlaod the file
    MsgBox "File DL failed. Make sure folder exist"
    GoTo ExitHere
End If
 
MsgBox "Thumbs up :-)" 
 
ExitHere:
    Exit Sub
errHere:
    MsgBox "Error"
    Resume ExitHere
End Sub
 
Public Function fnDownloadHTTP(strTarget As String, strSaveAs As String, Optional strUN As String, Optional strPW As String) As Boolean
On Error GoTo errHere
 
Dim xmlHTTP As Object
Dim strRespText As String
fnDownloadHTTP = True
Set xmlHTTP = CreateObject("Microsoft.XMLHTTP")
With xmlHTTP
    .Open "GET", strTarget, False, strUN, strPW
    .setRequestHeader "cache-control", "no-cache,must revalidate"
    .Send
    If fnSaveDownloadFile(strSaveAs, .responseBody) = False Then
        GoTo errHere
    End If
End With
 
ExitHere:
    Set xmlHTTP = Nothing
    Exit Function
 
errHere:
    fnDownloadHTTP = False
    Resume ExitHere
End Function
 
Private Function fnSaveDownloadFile(strFilePath, bytArray) As Boolean
On Error GoTo errHere
 
 
Dim objStream  As Object 'New ADODB.Stream
fnSaveDownloadFile = True
Set objStream = CreateObject("ADODB.Stream")
With objStream
    .Type = 1 'adTypeBinary
    .Open
    .Write bytArray
    .SaveToFile strFilePath, 2 'adSaveCreateOverWrite
End With
 
ExitHere:
    Exit Function
errHere:
    fnSaveDownloadFile = False
    Resume ExitHere
End Function

Combined the code, and it doesn't error, it just goes to the msg box "Check Download Folder"

Code:

Private Declare Function ShellExecute _
    Lib "shell32.dll" _
    Alias "ShellExecuteA" ( _
    ByVal hwnd As Long, _
    ByVal lpOperation As String, _
    ByVal lpFile As String, _
    ByVal lpParameters As String, _
    ByVal lpDirectory As String, _
    ByVal nShowCmd As Long) _
    As Long


Public Function DownloadFile(ByVal url As String, LocalFilename As String) As Boolean
    Dim lngRetVal As Long
    lngRetVal = URLDownloadToFileA(0, url, LocalFilename, 0, 0)
    If lngRetVal = 0 Then DownloadFile = True
End Function



 

    
    Sub DlFile()
            
            Dim strFile As String
            Dim strAction As String
            Dim lngErr As Long
            
            mypath = "C:\Documents and Settings\My Documents\ECDs\"
            fname = Dir(mypath & "059969-501" & "_SPEC.pdf")
        'If CheckBox1.Value = True Then
                If Len(fname) > 0 Then
            
                strFile = "C:\Documents and Settings\My Documents\ECDs\" & "059969-501" & "_SPEC.pdf"
                strAction = "OPEN"
                lngErr = ShellExecute(0, strAction, strFile, "", "", 0)
        
                Else
                    ' find file from server and display

                strFile = "http://eic.mmci.com/eic_drw/qr/" & "059969-501" & "/" & "059969-501" & "_SPEC.pdf"
                strAction = "open"
                lngErr = ShellExecute(0, strAction, strFile, "", "", 0)
                
On Error GoTo errHere
 
Dim strQRY As String
 
Dim strHTTP As String
Dim strFileToSave As String
 
strHTTP = strFile
strFileToSave = "C:\Documents and Settings\My Documents\ECDs\" & "059969-501" & "_SPEC.pdf"
 
If fnDownloadHTTP(strHTTP, strFileToSave) = False Then      ' -- downlaod the file
    MsgBox "File DL failed. Make sure folder exist"    GoTo ExitHere
End If
 
MsgBox "Thumbs up :-)"
 
ExitHere:
    Exit Sub
errHere:
    MsgBox "Error"
    Resume ExitHere
End If
End Sub
Public Function fnDownloadHTTP(strTarget As String, strSaveAs As String, Optional strUN As String, Optional strPW As String) As Boolean
On Error GoTo errHere
 
Dim xmlHTTP As Object
Dim strRespText As String
fnDownloadHTTP = True
Set xmlHTTP = CreateObject("Microsoft.XMLHTTP")
With xmlHTTP
    .Open "GET", strTarget, False, strUN, strPW
    .setRequestHeader "cache-control", "no-cache,must revalidate"
    .Send
    If fnSaveDownloadFile(strSaveAs, .responseBody) = False Then
        GoTo errHere
    End If
End With
 
ExitHere:
    Set xmlHTTP = Nothing
    Exit Function
 
errHere:
    fnDownloadHTTP = False
    Resume ExitHere
End Function
 
Private Function fnSaveDownloadFile(strFilePath, bytArray) As Boolean
On Error GoTo errHere
  
Dim objStream  As Object 'New ADODB.Stream
fnSaveDownloadFile = True
Set objStream = CreateObject("ADODB.Stream")
With objStream
    .Type = 1 'adTypeBinary
    .Open
    .Write bytArray
    .SaveToFile strFilePath, 2 'adSaveCreateOverWrite
End With
 
ExitHere:
    Exit Function
errHere:
    fnSaveDownloadFile = False
    Resume ExitHere
End Function
                End If
                
        'End If
    End Function

**tome10** · Aug 1st, 2011, 10:50 PM

I can't get the cache method to work. Howabout a 'save as' box pop up after the page is open, that is populated with the path already? All I have to do is hit save. Then again, that's pretty close to just doing it automatically.. Can you see what's wrong with the Cache Code I found?

**tome10** · Aug 11th, 2011, 03:01 PM

bump.. ;-)

**westconn1** · Aug 12th, 2011, 03:32 AM

without being able to try downloading the file from the site (with username and p'word) i can not help further

**tome10** · Aug 12th, 2011, 04:37 PM

How about a MSG Box pop up with the save as Dialog?

**westconn1** · Aug 13th, 2011, 04:19 AM

How about a MSG Box pop up with the save as Dialog?

to do that you have to automate the program that is opened by shellexecute, presumably acrobat reader or similar
you can show a messagebox after calling shellexecute, telling the user he needs to save, the messagebox may show before the program opens, then be sent behind the program that opens, unless you put some delay

you can try calling urldownloadtofile immediately after shell execute as the login may still be current

Thread: Open Save pdf Link

Thread Tools

Display

Open Save pdf Link

Re: Open Save pdf Link

Re: Open Save pdf Link

Re: Open Save pdf Link

Re: Open Save pdf Link

Re: Open Save pdf Link

Re: Open Save pdf Link

Re: Open Save pdf Link

Re: Open Save pdf Link

Re: Open Save pdf Link

Re: Open Save pdf Link

Re: Open Save pdf Link

Re: Open Save pdf Link

Re: Open Save pdf Link

Re: Open Save pdf Link

Re: Open Save pdf Link

Re: Open Save pdf Link

Re: Open Save pdf Link

Re: Open Save pdf Link

Re: Open Save pdf Link

Re: Open Save pdf Link

Re: Open Save pdf Link

Re: Open Save pdf Link

Re: Open Save pdf Link

Re: Open Save pdf Link

Re: Open Save pdf Link

Re: Open Save pdf Link

Re: Open Save pdf Link

Re: Open Save pdf Link

Re: Open Save pdf Link

Re: Open Save pdf Link

Re: Open Save pdf Link

Re: Open Save pdf Link

Tags for this Thread

Posting Permissions