Thanks for reading my post.
I was looking for a good way to automate downloading files from the web and I came accross thread705-1670052 with a link to the Vbnet website
Even though I don't really understand most of the code I did a copy and paste of the into a new form (using Access 2003) and I was happy to find that it seemed to work fine except the string returned to Text1 always said "Download failed or user pressed Cancel", even though in fact the download was successful.
My problem is that I really need to use this in an Access 2010 file and when I tried pasting it into a form in a 2010 file I was getting an error on the Private Declare Functions. After udating each with the PtrSafe attribute "Private Declare PtrSafe Function" that seemed to work but I still get a compile error "type missmatch" on the last function TrimNull where StrPtr is highlighted.
I anyone help me resolve this. Thanks in advance for any help. The entire code from Vbnet is shown below.
I was looking for a good way to automate downloading files from the web and I came accross thread705-1670052 with a link to the Vbnet website
Even though I don't really understand most of the code I did a copy and paste of the into a new form (using Access 2003) and I was happy to find that it seemed to work fine except the string returned to Text1 always said "Download failed or user pressed Cancel", even though in fact the download was successful.
My problem is that I really need to use this in an Access 2010 file and when I tried pasting it into a form in a 2010 file I was getting an error on the Private Declare Functions. After udating each with the PtrSafe attribute "Private Declare PtrSafe Function" that seemed to work but I still get a compile error "type missmatch" on the last function TrimNull where StrPtr is highlighted.
I anyone help me resolve this. Thanks in advance for any help. The entire code from Vbnet is shown below.
Code:
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const MAX_PATH As Long = 260
Private Const ERROR_SUCCESS As Long = 0&
Private Const INVALID_HANDLE_VALUE = -1
Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const REG_SZ As Long = 1
Private Const READ_CONTROL As Long = &H20000
Private Const KEY_QUERY_VALUE As Long = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ALL_ACCESS As Long = &HF003F
Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8
Private Const KEY_NOTIFY As Long = &H10
Private Const SYNCHRONIZE As Long = &H100000
Private Const STANDARD_RIGHTS_WRITE As Long = READ_CONTROL
Private Const KEY_READ As Long = ((READ_CONTROL Or _
KEY_QUERY_VALUE Or _
KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY) And _
(Not SYNCHRONIZE))
Private Const KEY_WRITE As Long = ((STANDARD_RIGHTS_WRITE Or _
KEY_SET_VALUE Or _
KEY_CREATE_SUB_KEY) And _
(Not SYNCHRONIZE))
Private Const KEY_EXECUTE As Long = (KEY_READ And (Not SYNCHRONIZE))
'registry key containing the Download Directory entry
Private Const sRegDownloadKey = "Software\Microsoft\Internet Explorer"
'a private type used to pass
'data to the function
Private Type FileRegistryDownloadData
DownloadDlgTitle As String 'custom download dialog title
DownloadTempRegKey As String 'temporary download destination folder to set in Reg
DownloadRemoteFileUrl As String 'full URL/name of download file
DownloadLocalFileName As String 'local file download filename
End Type
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Private Declare PtrSafe Function RegOpenKeyEx Lib "advapi32.dll" _
Alias "RegOpenKeyExA" _
(ByVal hKey As Long, _
ByVal lpSubKey As String, _
ByVal ulOptions As Long, _
ByVal samDesired As Long, _
phkResult As Long) As Long
Private Declare PtrSafe Function RegQueryValueEx Lib "advapi32.dll" _
Alias "RegQueryValueExA" _
(ByVal hKey As Long, _
ByVal lpValueName As String, _
ByVal lpReserved As Long, _
ByVal lpType As Long, _
ByVal lpData As Any, _
lpcbData As Long) As Long
Private Declare PtrSafe Function RegSetValueEx Lib "advapi32.dll" _
Alias "RegSetValueExA" _
(ByVal hKey As Long, _
ByVal lpszValueName As String, _
ByVal dwReserved As Long, _
ByVal dwType As Long, _
lpData As Any, _
ByVal nSize As Long) As Long
Private Declare PtrSafe Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
Private Declare PtrSafe Function DoFileDownload Lib "shdocvw.dll" _
(ByVal lpszFile As String) As Long
Private Declare PtrSafe Function FindWindow Lib "user32" _
Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare PtrSafe Sub Sleep Lib "kernel32" _
(ByVal dwMilliseconds As Long)
Private Declare PtrSafe Function IsWindow Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare PtrSafe Function SetWindowText Lib "user32" _
Alias "SetWindowTextA" _
(ByVal hwnd As Long, _
ByVal lpString As String) As Long
Private Declare PtrSafe Function lstrlenW Lib "kernel32" _
(ByVal lpString As Long) As Long
Private Declare PtrSafe Function FindFirstFile Lib "kernel32" _
Alias "FindFirstFileA" _
(ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare PtrSafe Function FindClose Lib "kernel32" _
(ByVal hFindFile As Long) As Long
Private Sub Form_Load()
Command1.Caption = "Download ABC File"
Text1.Text = ""
End Sub
Private Sub Command1_Click()
Dim dldata As FileRegistryDownloadData
With dldata
'custom string, if desired, to
'set as the title of the dialog.
'Leave blank if the default title
''File Download' is adequate
.DownloadDlgTitle = "VBnet Custom File Download Demo"
'the full URL (http or ftp) of the
'file to download to the above directory
.DownloadRemoteFileUrl = "[URL unfurl="true"]http://www.abc.ca.gov/datport/ABC_Data_Export.zip"[/URL]
'local or network path where the
'download dialog should offer to
'place the file - THIS PATH MUST EXIST
.DownloadTempRegKey = "C:\downloads"
'remember to set the filename here to the same name
'as the file being downloaded, otherwise you will receive
'a Failed message even though the file was successfully
'retrieved. If this code is being used in an app
'that needs to dynamically set the save filename, you
'can add code from PathStripPath: Removes Path Portion of Fully-qualified Path/Filename
'to automatically retrieve the file part of the URL being downloaded.
.DownloadLocalFileName = .DownloadTempRegKey & "\" & "powertoyxpsio.zip"
'--------------------
'this next If Then is for debugging;
'it deletes the file each time called
'so as to allow the proper message to
'be displayed following the call. This
'is not required for production
If FileExists(.DownloadLocalFileName) Then
Kill .DownloadLocalFileName
End If
'--------------------
If DownloadRemoteFile(dldata) = True Then
Text1.Text = "Download success!"
Else
Text1.Text = "Download failed or user pressed Cancel"
End If
End With
End Sub
Private Function DownloadRemoteFile(dldata As FileRegistryDownloadData) As Boolean
Dim hwndDlg As Long
Dim sDownloadFile As String
Dim sTmpRegHold As String
Dim bRegChanged As Boolean
'retrieve the user's current download
'directory by querying the registry under
'HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer
sTmpRegHold = RegGetDownloadDirectory()
'if the current download folder from
'the registry is not the same as the
'desired download folder, change it
If LCase$(sTmpRegHold) <> LCase$(dldata.DownloadTempRegKey) Then
'Change the registry from the user's
'last-saved folder to the desired
'download folder. Return and save
'a local flag indicating a change
'to the registry was made.
bRegChanged = RegSetDownloadDirectory(dldata.DownloadTempRegKey)
End If
'DoFileDownload requires a Unicode
'string so convert the desired path
'to Unicode and call api
sDownloadFile = StrConv(dldata.DownloadRemoteFileUrl, vbUnicode)
Call DoFileDownload(sDownloadFile)
'if a custom dialog title was specified
'in the dldata type, we have to give
'the dialog a chance to appear, then
'we can retrieve its handle and change
'the caption.
If Len(dldata.DownloadDlgTitle) > 0 Then
'Ensure dialog is displayed.
'You can either use the loop below,
'which waits for the hwndDlg to
'become valid, or you can use the
'commented out code below instead,
'which puts the app to sleep for a
'few milliseconds to let Windows
'create the dialog. Note that only
'one of the two method are needed!
'
'The advantage of the first is the
'dialog title is changed as soon as
'the dialog hwnd becomes valid, whereas
'the delay method may require tweaking
'to ensure sufficient delay is introduced
'to allow Windows to create the dialog.
'The disadvantage of the first method is,
'should the dialog creation fail, you'll
'stay in the loop. The downside to the
'delay method is a possible perceptible
'caption change, or, if the dialog is slow
'to appear, no title change will occur.
'You're choice!
'Loop method
Do
hwndDlg = FindWindow("#32770", "File Download")
Loop While hwndDlg = 0
'Delay method
'Call Sleep(150)
'hwndDlg = FindWindow("#32770", "File Download")
'assign the custom caption
If hwndDlg <> 0 Then
Call SetWindowText(hwndDlg, dldata.DownloadDlgTitle)
End If
End If
'Since we've changed the registry,
'it is only polite to change it
'back once we're done. This is
'accomplished by entering a loop
'and pausing the app while the
'dialog is on-screen. DoEvents
'ensures the app can process messages.
'The loop will terminate when the
'dialog has closed, either from a
'successful download or from the
'user selecting Cancel. This
'information can't be determined here,
'so later we do a test for the file
'(a FileExists) to determine the
'success of the action.
Do
Call Sleep(50)
DoEvents
Loop Until IsWindow(hwndDlg) = False
'The download is done or has been
'cancelled, so first reset the user's
'original download folder if changed
If bRegChanged Then
Call RegSetDownloadDirectory(sTmpRegHold)
End If
'now check the download was successful,
'and return that as the success of this
'routine
DownloadRemoteFile = FileExists(dldata.DownloadLocalFileName)
End Function
Private Function RegGetDownloadDirectory() As String
Dim hKey As Long
Dim sizeData As Long
Dim tmpdata As String
If RegOpenKeyEx(HKEY_CURRENT_USER, _
sRegDownloadKey, _
0, _
KEY_READ, _
hKey) = ERROR_SUCCESS Then
tmpdata = Space$(MAX_PATH)
sizeData = Len(tmpdata)
Call RegQueryValueEx(hKey, _
"Download Directory", _
0, 0, _
tmpdata, _
sizeData)
'strip trailing nulls and return
RegGetDownloadDirectory = TrimNull(tmpdata)
End If
Call RegCloseKey(hKey)
End Function
Private Function RegSetDownloadDirectory(sRegDownloadDir As String) As Boolean
Dim hKey As Long
Dim tmpdata As String
If RegOpenKeyEx(HKEY_CURRENT_USER, _
sRegDownloadKey, _
0, _
KEY_WRITE, _
hKey) = ERROR_SUCCESS Then
RegSetDownloadDirectory = RegSetValueEx(hKey, _
"Download Directory", _
0&, _
REG_SZ, _
ByVal sRegDownloadDir & vbNullChar, _
Len(sRegDownloadDir) + 1) = ERROR_SUCCESS
End If
Call RegCloseKey(hKey)
End Function
Private Function FileExists(sSource As String) As Boolean
Dim WFD As WIN32_FIND_DATA
Dim hFile As Long
hFile = FindFirstFile(sSource, WFD)
FileExists = hFile <> INVALID_HANDLE_VALUE
Call FindClose(hFile)
End Function
Private Function TrimNull(startstr As String) As String
TrimNull = Left$(startstr, lstrlenW(StrPtr(startstr)))
End Function