Access VB to save Excel file

[ggodwin]

I have an Access function that navigates to a website and downloads an excel file. The excel file is called.

"DownloadNCPartListServlet.xls" I would like to save this file to c:\owner\documents\

I would like to name the file ("Update_" + todays date)

One possible problem. ( I am not sure??) the Excel file downloads into Excel through the web browser window. I can not get this switch into Excel.

(This is a Vista machine BTW)

Does anyone have a line of code that will save this excel file in that format and will work in Access?

[Ecniv]

You can get at it through API calls.... depending on what you are programming in.

There is a way to request files via http url (close to the ftp version) and I have done ftp in vba coding before.

If you are using .net it may already be built in though.

Api for FTP here... should give you an idea.

Also found this on a quick search : Microsoft site

[ggodwin]

I am not having a problem with the download. I am able to get the data.
I just need to tell the application to save it and give it the file name details that I need.

[Siddharth Rout]

I am not having a problem with the download. I am able to get the data.

Can I see what have you got till now...

[ggodwin]

Down at the very bottom.

Option Compare Database
Option Explicit
Public Function SKPIUPDATE()

Dim QPR As Object
Dim lnk As Object
Dim TimeOut As String
Dim frm As Object
Dim Start As Object
Dim Finish As Object
Dim drp2 As Object
Dim drp1 As Object
Dim src1 As Object
Dim p1 As Variant
Dim objExc As Object
Dim objWB As Object
 
Set QPR = CreateObject("InternetExplorer.application")
 
    QPR.Visible = True
    
    QPR.navigate "https://www.portal.toyotasupplier.com/wps/myportal/"
    
  TimeOut = Now + TimeValue("00:00:20")  '-- wait maximum of 20 seconds
   Do While QPR.Busy Or QPR.readyState <> 4
      DoEvents
      If Now > TimeOut Then
        MsgBox "Time Out before Login"
        Exit Function
      End If
   Loop
 
   With QPR.Document.Forms("Login")
      .User.Value = "***********"
      .Password.Value = "*******"
      .submit
   End With
 
   TimeOut = Now + TimeValue("00:00:40")  '-- wait maximum of 10 seconds
   Do While QPR.Busy Or QPR.readyState <> 4
      DoEvents
      If Now > TimeOut Then
         MsgBox "Time Out after Login"
         Exit Function
      End If
   Loop
    QPR.navigate ("https://www.portal.toyotasupplier.com/skpi/")
    
      TimeOut = Now + TimeValue("00:00:05")  '-- wait 1 second for above navigation to take effect
      Do While Now < TimeOut
         DoEvents
      Loop
    
    TimeOut = Now + TimeValue("00:00:50")  '-- wait maximum of 10 seconds
   Do While QPR.Busy Or QPR.readyState <> 4
      DoEvents
      If Now > TimeOut Then
         MsgBox "Did not navigate to SKPI application"
         Exit Function
      End If
   Loop
     
   Set lnk = QPR.Document.Links(3)   ' 3=TMMK-VEH,4=TMMK-PWT,5=TMMC,6=TMMTX,7=TABC,8=NUMMI,9=TMMI,10=TMMBC,11=TMMAL,12=TMMNK
   lnk.Click
   
   TimeOut = Now + TimeValue("00:00:20")  '-- wait 1 second for above navigation to take effect
      Do While Now < TimeOut
         DoEvents
   Loop
   
   QPR.navigate ("https://www.portal.toyotasupplier.com/skpi/SkpiGatewayServlet?jadeAction=NCPARTS_SEARCH")
   
         TimeOut = Now + TimeValue("00:00:05")  '-- wait 1 second for above navigation to take effect
      Do While Now < TimeOut
         DoEvents
      Loop
   
    Set frm = QPR.Document.Forms("form1")
        
    Set Start = frm.all("SKPI_SEARCH_START_DATE_KEY")
    Start.Value = "01/01/" & Year(Now)
    
    Set Finish = frm.all("SKPI_SEARCH_END_DATE_KEY")
    Finish.Value = Format(Now - 1, "mm/dd/yyyy")
    
    Set drp2 = frm.all("SKPI_SEARCH_NC_TYPE_KEY")
    drp2.Item(1).Selected = True
    
    Set drp1 = frm.all("SKPI_SEARCH_NAMC_KEY")
    drp1.Item(p1).Selected = True
    
    Set src1 = frm.all("Submit")
    
    src1.Click
    
    TimeOut = Now + TimeValue("00:00:05")  '-- wait 1 second for above navigation to take effect
      Do While Now < TimeOut
         DoEvents
    Loop
        
    QPR.navigate ("https://www.portal.toyotasupplier.com/skpi/DownloadNCPartListServlet") ' this download the Excel file DownloadNCPartListServlet.xls
    
    TimeOut = Now + TimeValue("00:01:00")  '-- wait 1 minute for above navigation to take effect
    Do While Now < TimeOut
         DoEvents
    Loop
    
   Set objExc = CreateObject("Excel.Application")
   
   objExc.Visible = True  'comment out if not required
   
   Set objWB = objExc.("Download.xls")
      
   objWB.SaveAs "C:SKPIUPDATE.xls"
    
   'QPR.navigate ("https://www.portal.toyotasupplier.com/public/pr_logout.htm")
   
End Function

[Siddharth Rout]

Try this

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

Sub DownloadFileFromWeb()
On Error GoTo err_1
    'Insert the file link below
    Const strUrl As String = "http://www.koolsid.com/Myfile.xls" 'example link
    Dim strSavePath As String
    Dim returnValue As Long
    'Path to save the file
    strSavePath = "c:/temp"
    returnValue = URLDownloadToFile(0, strUrl, strSavePath, 0, 0)

Err_Exit:
    Exit Sub
err_1:
    MsgBox Err.Description
    Resume Err_Exit
End Sub

[ggodwin]

Kool...
thanks for the help.

Where should that go and what should I pull out?

[Siddharth Rout]

Instead of

Set objExc = CreateObject("Excel.Application")

objExc.Visible = True 'comment out if not required

Set objWB = objExc.("Download.xls")

objWB.SaveAs "C:SKPIUPDATE.xls"

Use this

On Error GoTo err_1
'Insert the file link below
Const strUrl As String = "http://www.koolsid.com/Myfile.xls" 'example link
Dim strSavePath As String
Dim returnValue As Long
'Path to save the file
strSavePath = "c:/temp"
returnValue = URLDownloadToFile(0, strUrl, strSavePath, 0, 0)

Err_Exit:
Exit Sub
err_1:
MsgBox Err.Description
Resume Err_Exit

This

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

will go after

Option Explicit

in your code.

Regarding the errorhandling

[ggodwin]

I got a compile error. Exit sub not allowed in Function or property

Exit Sub

[Siddharth Rout]

My Apologies

Remove these two lines

Err_Exit:
Exit Sub

as you are using a function... I was using a sub

[ggodwin]

Ok now I got a compile error "label not defined"

error on this line:

Resume Err_Exit

[Ecniv]

Put in :

Err_Exit:
'line above is a label - if you are using goto on the error or elsewhere you should know this
exit function
'equivalent of exit sub - but for a function

[ggodwin]

Thanks I will try that one.

[ggodwin]

I am not real sure what has happened.

But I got a msg box/button pop up that say's Microsoft Access "OK".

When I click the "OK" I get a Run-Time Error 20 "Resume with out Err"

Debug goes to this code:

err_1:
    MsgBox Err.Description
    Resume Err_Exit
Err_Exit:

FWIW - The excel file is getting downloaded.

[ggodwin]

Just for reference here is my code:

Option Compare Database
Option Explicit
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

Public Function SKPIUPDATE()

Dim QPR As Object
Dim lnk As Object
Dim TimeOut As String
Dim frm As Object
Dim Start As Object
Dim Finish As Object
Dim drp2 As Object
Dim drp1 As Object
Dim src1 As Object
Dim p1 As Variant
Dim objWB As Object
Dim objExc As Object

 
Set QPR = CreateObject("InternetExplorer.application")
 
    QPR.Visible = True
    
    QPR.navigate "https://www.portal.toyotasupplier.com/wps/myportal/"
    
  TimeOut = Now + TimeValue("00:00:20")  '-- wait maximum of 20 seconds
   Do While QPR.Busy Or QPR.readyState <> 4
      DoEvents
      If Now > TimeOut Then
        MsgBox "Time Out before Login"
        Exit Function
      End If
   Loop
 
   With QPR.Document.Forms("Login")
      .User.Value = "********"
      .Password.Value = "********"
      .submit
   End With
 
   TimeOut = Now + TimeValue("00:00:40")  '-- wait maximum of 10 seconds
   Do While QPR.Busy Or QPR.readyState <> 4
      DoEvents
      If Now > TimeOut Then
         MsgBox "Time Out after Login"
         Exit Function
      End If
   Loop
    QPR.navigate ("https://www.portal.toyotasupplier.com/skpi/")
    
      TimeOut = Now + TimeValue("00:00:05")  '-- wait 1 second for above navigation to take effect
      Do While Now < TimeOut
         DoEvents
      Loop
    
    TimeOut = Now + TimeValue("00:00:50")  '-- wait maximum of 10 seconds
   Do While QPR.Busy Or QPR.readyState <> 4
      DoEvents
      If Now > TimeOut Then
         MsgBox "Did not navigate to SKPI application"
         Exit Function
      End If
   Loop
     
   Set lnk = QPR.Document.Links(3)   ' 3=TMMK-VEH,4=TMMK-PWT,5=TMMC,6=TMMTX,7=TABC,8=NUMMI,9=TMMI,10=TMMBC,11=TMMAL,12=TMMNK
   lnk.Click
   
   TimeOut = Now + TimeValue("00:00:20")  '-- wait 1 second for above navigation to take effect
      Do While Now < TimeOut
         DoEvents
   Loop
   
   QPR.navigate ("https://www.portal.toyotasupplier.com/skpi/SkpiGatewayServlet?jadeAction=NCPARTS_SEARCH")
   
         TimeOut = Now + TimeValue("00:00:05")  '-- wait 1 second for above navigation to take effect
      Do While Now < TimeOut
         DoEvents
      Loop
   
    Set frm = QPR.Document.Forms("form1")
        
    Set Start = frm.all("SKPI_SEARCH_START_DATE_KEY")
    Start.Value = "01/01/" & Year(Now)
    
    Set Finish = frm.all("SKPI_SEARCH_END_DATE_KEY")
    Finish.Value = Format(Now - 1, "mm/dd/yyyy")
    
    Set drp2 = frm.all("SKPI_SEARCH_NC_TYPE_KEY")
    drp2.Item(1).Selected = True
    
    Set drp1 = frm.all("SKPI_SEARCH_NAMC_KEY")
    drp1.Item(p1).Selected = True
    
    Set src1 = frm.all("Submit")
    
    src1.Click
    
    TimeOut = Now + TimeValue("00:00:05")  '-- wait 1 second for above navigation to take effect
      Do While Now < TimeOut
         DoEvents
    Loop
        
    QPR.navigate ("https://www.portal.toyotasupplier.com/skpi/DownloadNCPartListServlet")
    
    TimeOut = Now + TimeValue("00:01:00")  '-- wait 1 minute for above navigation to take effect
    Do While Now < TimeOut
         DoEvents
    Loop
       
    'Insert the file link below
    Const strUrl As String = "https://www.portal.toyotasupplier.com/skpi/DownloadNCPartListServlet" 'example link
    Dim strSavePath As String
    Dim returnValue As Long
    'Path to save the file
    strSavePath = "C:\Documents and Settings\dsggodwin\My Documents\_DENSO QRE"
    returnValue = URLDownloadToFile(0, strUrl, strSavePath, 0, 0)
    
err_1:
    MsgBox Err.Description
    Resume Err_Exit
Err_Exit:
   
   QPR.navigate ("https://www.portal.toyotasupplier.com/public/pr_logout.htm")
   
End Function

[ggodwin]

Any new suggestions on this issue?

[Siddharth Rout]

can you upload you file?

[ggodwin]

Anything for help..

If you need the username and password I can send it to you.

Thanks!

[Siddharth Rout]

yeah that too but first the file....

[ggodwin]

I actually thought I uploaded it....?

lets try again..

[Siddharth Rout]

just remove this entire part

err_1:
MsgBox Err.Description
Resume Err_Exit
Err_Exit:

Now what do you get?

In the meantime I will check the file...

[ggodwin]

It runs with out an error. But the file does not save.

[Siddharth Rout]

yeah I noticed that...

Okay do this

Either comment the last line which logs you out or put in some wait time before it... and now run the code...

i tried it and it works

[ggodwin]

Still not saving on my end regardless the method. Either adding the delay or commenting out the logout request..

I have no idea what could be wrong.? What is the file name and were would it save it? I see the path? but maybe I am missing it?

If/when a user navigates to this location the user always receives a prompt that as what they want to do. Open or save the file This is a prompt that you can "un check" to eliminate in the future. For me it is set to open with out the prompt.

Could that be a difference? If you navigate there manually will you get the prompt?

[Siddharth Rout]

If/when a user navigates to this location the user always receives a prompt that as what they want to do. Open or save the file This is a prompt that you can "un check" to eliminate in the future. For me it is set to open with out the prompt.

Are you at least getting the prompt to open the file or to save it via code?

[ggodwin]

No.

I am not getting it. Which is what happens when the check is applied. Is that a simple cookie or is it changing the registry?

[Siddharth Rout]

If the checkbox is checked then it will ask you to either open the file or save the file. If the checkbox is not checked then it will download the file and open the excel file in the same browser. At least that is what has happened with me...

[ggodwin]

Ok. Please confirm.
Did the downloaded excel file open in the explorer or in excel? If this code requires it to be opened in the IE Browser I can fix that on mine.

Did you get the file to save? If yes, what is the file name and location?

[Siddharth Rout]

Did the downloaded excel file open in the explorer or in excel?

It opened in explorer when the check box was not checked

Did you get the file to save? If yes, what is the file name and location?

yes, I got the file to save when there was a check on the checkbox. Give me some time for the file name as I will have to mail the code to one of my friends pc as I don't have access to net (except vbforums on this pc...

Edit:

okay Here is a step by step screenshot when the checkbox is checked

[ggodwin]

Well,
I have tried all the possible checks and unchecks and the only way I can save the file is manually.

When you got it to save did the VB code do the work or was it you? I am assuming it was the code doing it automatically.