Read this for full information on these modules
Another deadly simple and endlessly useful module, lifted from Mr Excel. Note that you can do a lot of things automatically with Firefox if you install the LastPass addon, which stores your site login information and automatically logs in to a site. This means you can easily download a remote file from a web server somewhere just by opening the URL for the file using ff_GetDownload. I don't think it's usually necessary to log in to the site first, LastPass will handle that, but it certainly doesn't do any harm, it just opens an extra FF tab.
When downloading a file, Firefox will save the actual filename.ext with 0 bytes as a placeholder, and create filename.ext.part which is the actual downloading file. When FF completes the download, it'll delete the original filename.ext file, and rename the filename.ext.part file to filename.ext. So when it's completed the download, filename.ext will instantly be > 0 bytes.
Code for Sleep:
'source: http://www.vboffice.net/sample.html?mnu=2&lang=en&smp=56&cmd=showitem&pub=6
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliSeconds As Long)
Private Const fwLoginURL As String = "http://forwin.dhl.com" 'can be set to any site login
Public Sub Sleep_Test()
'source: http://www.vboffice.net/sample.html?mnu=2&lang=en&smp=56&cmd=showitem&pub=6
Sleep 3000
MsgBox "Hello"
End Sub
This uses code from modSpecialFolders to find the location of the user's Downloads folder but you can also hard-code the path if preferred.
I've never managed to get Internet Explorer to work in the same way, (un)surprisingly Microsoft just don't make it easy. There's plenty of support online if you really must use IE, e.g. if your corporate policy doesn't permit LastPass for automatic logins.
'modAppsFirefox
'v3.04 2013-09-20 13:32
'===========================================================================
' HELP CONTACT
'===========================================================================
' Code is provided without warranty and can be stolen and amended as required.
' Tom Parish
' TJP@tomparish.me.uk
' http://baldywrittencod.blogspot.com
' DGF Help Contact: see BPMHelpContact module
'=========================================================================
'===========================================================================
' modAppsFirefox
'===========================================================================
' macros to load URL in Firefox, based on open source code:
' http://www.mrexcel.com/forum/excel-questions/568204-opening-url-firefox-excel.html
'
' Automatically determines standard Windows 7 Downloads folder location.
' Specify custom Downloads folder location as Private Const below.
'
' Save your site login details with the LastPass addon, and make sure it's
' set to always autologin to the site.
'===========================================================================
' Additional modules required:
'===========================================================================
' modFile v1.03
'
' Code included from other modules:
' [modSpecialFolders]
'===========================================================================
' Additional References required:
'===========================================================================
' None
'===========================================================================
' External applications required:
'===========================================================================
' Mozilla Firefox
' LastPass Firefox Addon
'===========================================================================
' VERSION HISTORY
'===========================================================================
' v3.04 minor edit, variable name change in modFile
' v3.03 ffGetSimultDownloads counts .part files in DLs folder
' v3.02 always wait for completion if running outside office hours
' v3.01 ffGetDownload = ffFileURL for queued downloads when max dl reached
' v3.00 works with modProcedures
' v2.01 ff_GetDownload: added ffLoginTime and improved ffSleepTime usage
' added ErrorHandlerNoFile
' v2.00 transferred code from modSpecialFolders
' v1.06 ff_GetDownload: bugfix, potentially .part file is newer
' v1.05 ff_GetDownload: redesigned download completion detection
' extended ffSleepTime
' improved annotations
' v1.04 added Private Const ffSleepTime
' v1.03 ff_GetDownload: only waits for site login if necessary
' v1.02 transferred ff_GetDownload from modForwin (was Forwin_GetDownload)
' v1.01aa renamed modAppsFirefox
' v1.01a annotations only
' v1.01 refers modSpecialFolders
' v1.00 original code from source:
' http://www.mrexcel.com/forum/excel-questions/568204-opening-url-firefox-excel.html
Option Explicit
Private Const ffSpecifyDownloadFolder As String = ""
'source: http://www.vboffice.net/sample.html?mnu=2&lang=en&smp=56&cmd=showitem&pub=6
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliSeconds As Long)
Private Const ffLoginTime As Long = 20000 'v2.01, 10s is too short to allow login and file transfer to begin
'!! if 1000ms causes issues, try a longer time
Private Const ffSleepTime As Long = 1000 'v1.05, ms, i.e. 10000ms = 10s
'NB: Firefox can only run N simultaneous downloads, must store further URLs as Download procedures
'!! may need to improve this by clearing completed downloads? (i.e. run modProcedures.mp_Run_Procedures on sheets 1 and 2)
Public Const ffMaxSimultDownloads As Byte = 5 'v3.03 'v3.01
Private Const ffDownloadWaitTime As Long = 60000 'v3.01 - only if ffWaitForCompletion = True
Private Const ffOffHrsMin As Byte = 9 'ALWAYS waits if Now < this
Private Const ffOffHrsMax As Byte = 18 'ALWAYS waits if Now > this
Private Const ffWEDay1 As String = "Sat" 'ALWAYS waits if running on Sat
Private Const ffWEDay2 As String = "Sun" 'change to Mon or "" as applicable to your country
Public ffCompleted As Boolean 'v3.00
'=================================================================================================
'=================================================================================================
'=================================================================================================
'=================================================================================================
'
' Code from modSpecialFolders module:
'
'http://answers.microsoft.com/en-us/office/forum/office_2010-customize/how-2-refer-to-desktop/97eba910-54c9-409f-9454-6d7c8d54d009
Private Declare Function SHGetSpecialFolderLocation _
Lib "shell32" (ByVal hwnd As Long, _
ByVal nFolder As Long, ppidl As Long) As Long
Private Declare Function SHGetPathFromIDList _
Lib "shell32" Alias "SHGetPathFromIDListA" _
(ByVal Pidl As Long, ByVal pszPath As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32" (ByVal pvoid As Long)
'Desktop
Private Const CSIDL_INTERNET = &H1 'Internet Explorer (icon on desktop)
Private Const CSIDL_PROGRAMS = &H2 'Start Menu\Programs
Private Const CSIDL_CONTROLS = &H3 'My Computer\Control Panel
Private Const CSIDL_PRINTERS = &H4 'My Computer\Printers
Private Const CSIDL_PERSONAL = &H5 'My Documents
Private Const CSIDL_FAVORITES = &H6 '<user name>\Favorites
Private Const CSIDL_STARTUP = &H7 'Start Menu\Programs\Startup
Private Const CSIDL_RECENT = &H8 '<user name>\Recent
Private Const CSIDL_SENDTO = &H9 '<user name>\SendTo
Private Const CSIDL_BITBUCKET = &HA '<desktop>\Recycle Bin
Private Const CSIDL_STARTMENU = &HB '<user name>\Start Menu
Private Const CSIDL_DESKTOPDIRECTORY = &H10 '<user name>\Desktop
Private Const CSIDL_DRIVES = &H11 'My Computer
Private Const CSIDL_NETWORK = &H12 'Network Neighborhood
Private Const CSIDL_NETHOOD = &H13 '<user name>\nethood
Private Const CSIDL_FONTS = &H14 'Windows\fonts
Private Const CSIDL_TEMPLATES = &H15
Private Const CSIDL_COMMON_STARTMENU = &H16 'All Users\Start Menu
Private Const CSIDL_COMMON_PROGRAMS = &H17 'All Users\Programs
Private Const CSIDL_COMMON_STARTUP = &H18 'All Users\Startup
Private Const CSIDL_COMMON_DESKTOPDIRECTORY = &H19 'All Users\Desktop
Private Const CSIDL_APPDATA = &H1A '<user name>\Application Data
Private Const CSIDL_PRINTHOOD = &H1B '<user name>\PrintHood
Private Const CSIDL_LOCAL_APPDATA = &H1C '<user name>\Local Settings\Application Data (non roaming)
Private Const CSIDL_ALTSTARTUP = &H1D 'non localized startup
Private Const CSIDL_COMMON_ALTSTARTUP = &H1E 'non localized common startup
Private Const CSIDL_COMMON_FAVORITES = &H1F
Private Const CSIDL_INTERNET_CACHE = &H20
Private Const CSIDL_COOKIES = &H21
Private Const CSIDL_HISTORY = &H22
Private Const CSIDL_COMMON_APPDATA = &H23 'All Users\Application Data
Private Const CSIDL_WINDOWS = &H24 'Windows Directory
Private Const CSIDL_SYSTEM = &H25 'System Directory
Private Const CSIDL_PROGRAM_FILES = &H26 'C:\Program Files
Private Const CSIDL_MYPICTURES = &H27 'C:\Program Files\My Pictures
Private Const CSIDL_PROFILE = &H28 'USERPROFILE
Private Const CSIDL_SYSTEMX86 = &H29 'x86 system directory on RISC
Private Const CSIDL_PROGRAM_FILESX86 = &H2A 'x86 C:\Program Files on RISC
Private Const CSIDL_PROGRAM_FILES_COMMON = &H2B 'C:\Program Files\Common
Private Const CSIDL_PROGRAM_FILES_COMMONX86 = &H2C 'x86 Program Files\Common on RISC
Private Const CSIDL_COMMON_TEMPLATES = &H2D 'All Users\Templates
Private Const CSIDL_COMMON_DOCUMENTS = &H2E 'All Users\Documents
Private Const CSIDL_COMMON_ADMINTOOLS = &H2F 'All Users\Start Menu\Programs\Administrative Tools
Private Const CSIDL_ADMINTOOLS = &H30 '<user name>\Start Menu\Programs\Administrative Tools
Private Const CSIDL_CONNECTIONS = &H31 'Network and Dial-up Connections
Private Const MAX_PATH = 260
Private Const NOERROR = 0
Private Function SpecFolder(ByVal lngFolder As Long) As String
Dim lngPidlFound As Long
Dim lngFolderFound As Long
Dim lngPidl As Long
Dim strPath As String
strPath = Space(MAX_PATH)
lngPidlFound = SHGetSpecialFolderLocation(0, lngFolder, lngPidl)
If lngPidlFound = NOERROR Then
lngFolderFound = SHGetPathFromIDList(lngPidl, strPath)
If lngFolderFound Then
SpecFolder = Left$(strPath, _
InStr(1, strPath, vbNullChar) - 1)
End If
End If
CoTaskMemFree lngPidl
End Function
Sub Test_OpenFireFoxNewTab()
OpenInFireFoxNewTab "http://www.mrexcel.com/forum/forumdisplay.php?f=10"
End Sub
Sub OpenInFireFoxNewTab(url As String)
'v2.00 2013-08-09 11:59
Dim pathFireFox As String
pathFireFox = SpecFolder(CSIDL_PROGRAM_FILES) & "\Mozilla Firefox\firefox.exe" 'v1.01
If Dir(pathFireFox) = "" Then pathFireFox = "C:\Program Files (x86)\Mozilla Firefox\firefox.exe"
If Dir(pathFireFox) = "" Then pathFireFox = "C:\Program Files\Mozilla Firefox\firefox.exe"
If Dir(pathFireFox) = "" Then
MsgBox "FireFox Path Not Found", vbCritical, "Macro Ending"
Exit Sub
End If
Shell """" & pathFireFox & """" & " -new-tab " & url, vbHide
End Sub
Function ff_GetDownload(ByVal ffFileURL As String, ByVal ffFileExt As String _
, Optional ByVal ffNewFileName As String, Optional ByVal ffWaitForCompletion As Boolean) As String
'v3.04 2013-09-20 13:32
'launches FireFox, logs in to web server, downloads Filename.FileExt
'then renames to specified [ffNewFileName] OR [cDefaultFilename].[ffFileExt]
'reports back new path & filename (NB: default is [userpath]\Downloads\[cDefaultFilename].[ffFileExt])
'v3.00 can report back temporary filename for use with modProcedures
ffCompleted = False 'v3.00
Const ffLoginURL As String = "" 'optional, forces login before launching actual URL
Dim sCount As Byte 'counts and limits number of sleeps
On Error Resume Next 'validity checks done at end
If ffGetCurrentSimultDownloads < ffMaxSimultDownloads Then 'v3.01
'download this file
'launch web server in FF (automatic login is handled with LastPass addon)
If ffLoginURL <> "" Then
modAppsFirefox.OpenInFireFoxNewTab ffLoginURL
'wait for LastPass to log in
Sleep ffLoginTime
End If
'launch URL to download (FF will automatically download files to user's specified Downloads folder)
Dim dCreatedDate As Double
dCreatedDate = Now() 'records date & time file creation was started, prevents false "newset file" matches
modAppsFirefox.OpenInFireFoxNewTab ffFileURL
'minimum pause for LastPass to log in to site, and file transfer to begin
'!! take care: if this causes the wrong file to be detected, increase ffLoginTime
Sleep ffLoginTime
'get file name for NEWEST file in Downloads folder
'Firefox creates file.ext.part AND file.ext
Dim pthDL As String, ffDownloadingFile As String
pthDL = ffSpecifyDownloadFolder 'can specify path as Private Const
If pthDL = "" Then pthDL = Replace(SpecFolder(CSIDL_PERSONAL), "\Documents", "\Downloads\") 'also adds trailing slash
FindNewestFile:
ffDownloadingFile = modFile.mfLoopThroughFilesInAFolder(mfPath:=pthDL, mfNewestFile:=True, mfNewestFileNewerThan:=dCreatedDate) 'v3.04
If ffDownloadingFile = "" Then
'newest file not found, wait then try again
sCount = sCount + 1
Sleep ffSleepTime
If sCount < 10 Then GoTo FindNewestFile 'prevent endless loop
End If
If ffDownloadingFile = "" Then GoTo ErrorHandlerNoFile
ffDownloadingFile = Replace(ffDownloadingFile, ".part", "") 'catch potential errors due to .part file being newer
'whilst downloading, file.ext placeholder will exist with 0 bytes, file.ext.part is temporary downloading file
'on completion, file.ext wil be deleted, then file.ext.part will be renamed, so file.ext will be >0 bytes
'v3.02 regardless of user setting, always wait for completion if running outside office hours
If ffWaitForCompletion = True _
Or Hour(Now()) < ffOffHrsMin _
Or Hour(Now()) >= ffOffHrsMax _
Or Format(Now(), "Ddd") = ffWEDay1 _
Or Format(Now(), "Ddd") = ffWEDay2 _
Then
Dim f1 As Double
On Error Resume Next
f1 = FileLen(ffDownloadingFile)
Do While f1 = 0
'when download completes, ffDownloadingFile is deleted (i.e. error) then reappears with f1 > 0
f1 = FileLen(ffDownloadingFile)
Loop
On Error GoTo 0
ffCompleted = True
'rename downloaded file if specified
'NB: renaming .csv to .xls will cause you problems!
If ffNewFileName <> "" Then
'use specified filename
ff_GetDownload = ffNewFileName
Else
'use default download filename
Const cDefaultFilename As String = "Downloaded Web Server Report." ' & ffFileExt
Const cPrd As String = "."
ffFileExt = Replace(LCase(ffFileExt), cPrd, "")
ff_GetDownload = cDefaultFilename & ffFileExt
End If
'before renaming download file, kill target filename, if it exists
If Dir(ff_GetDownload) <> "" Then Kill ff_GetDownload
'rename/move downloaded file
Name ffDownloadingFile As ff_GetDownload
'validity check to confirm download completed
If Dir(ff_GetDownload) = "" Then
'downloaded file doesn't exist, something went wrong
MsgBox "Downloaded file not found", vbCritical, "Error in ff_GetDownload"
GoTo ErrorHandlerNoFile
End If
Else 'ffWaitForCompletion = False AND during business hours
'don't wait, store the first N download procedures for processing later
'NB: capture this in parent macro
ff_GetDownload = ffDownloadingFile
'NB: ff_GetDownload <> ffNewFileName
End If
Else
'too many simultaneous downloads already, store this download URL for later
'NB: must capture this in parent macro
ff_GetDownload = ffFileURL
End If
On Error GoTo 0
Exit Function
ErrorHandlerNoFile:
ff_GetDownload = ""
End Function
Function ffGetCurrentSimultDownloads() As Byte
'v3.03 2013-09-13 11:05
'counts .part files in Downloads folder
'Firefox can only run ffMaxSimultDownloads
Dim pthDL As String
Const ffDLpartfile As String = ".part"
pthDL = ffSpecifyDownloadFolder 'can specify path as Private Const
If pthDL = "" Then pthDL = Replace(SpecFolder(CSIDL_PERSONAL), "\Documents", "\Downloads\") 'also adds trailing slash
ffGetCurrentSimultDownloads = modFile.mfLoopThroughFilesInAFolder(mfPath:=pthDL _
, mfSearchString:=ffDLpartfile, mfCountMatches:=True)
End Function
No comments:
Post a Comment