Access VB to save Excel file

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?

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

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.

Quote:

---

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...

Down at the very bottom.

Code:

---

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

---

Try this

Code:

---

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

---

Kool...
thanks for the help.

Where should that go and what should I pull out?

Instead of

Quote:

---

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

Quote:

---

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

Quote:

---

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

Quote:

---

Option Explicit

---

in your code.

Regarding the errorhandling

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

Code:

---

Exit Sub

---

My Apologies

Remove these two lines

Quote:

---

Err_Exit:
Exit Sub

---

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

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

error on this line:

Code:

---

Resume Err_Exit

---

Put in :

Code:

---

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

---

Thanks I will try that one.

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:

Code:

---

err_1:
    MsgBox Err.Description
    Resume Err_Exit
Err_Exit:

---

FWIW - The excel file is getting downloaded.

Just for reference here is my code:

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

---

Any new suggestions on this issue?

can you upload you file?

Anything for help..:D

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

Thanks!

yeah that too :) but first the file....

I actually thought I uploaded it....?

lets try again..

just remove this entire part

Quote:

---

err_1:
MsgBox Err.Description
Resume Err_Exit
Err_Exit:

---

Now what do you get?

In the meantime I will check the file...

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

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 :)

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?

Quote:

---

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?

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?

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...

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?

Quote:

---

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

---

It opened in explorer when the check box was not checked

Quote:

---

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

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.