I'm currently creating a program that downloads URL links as PDF and stores it into my local storage. The problem is that, when it encounters a duplicate name then it overwrites. Any thoughts on instead of overwriting the existing file, It should just add (2) on the end.
My code here is
Private Declare PtrSafe Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As LongPtr, _
ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As LongPtr) As Long
Sub DownloadFile()
Dim downloadStatus As Variant
Dim Url As String
Dim destinatioFile_Local As String
Dim i As Integer
i = 1
Do Until IsEmpty(Cells(i, 1)) = True
Url = (Cells(i, 1))
destinationFile_local = "C:\Users\name\Desktop\test" & filename(Cells(i, 1))
downloadStatus = URLDownloadToFile(0, Url, destinationFile_local, 0, 0)
If downloadStatus = 0 Then
MsgBox "Downloaded"
Else
MsgBox "Download fail"
End If
i = i + 1
Loop
End Sub
Function filename(file_fullname) As String
filename = Mid(file_fullname, InStrRev(file_fullname, "/") + 1)
End Function
Related
I am trying to download files located on a network via an ftp connection from a VBA macro. my concern is that the file changes according to the need. so I have to use a regular expression to find the file to download. i define a function ftpDownload like this:
Function FtpDownload(ByVal strRemoteFile As String, ByVal strLocalFile As String, ByVal strHost As String, ByVal lngPort As Long, ByVal strUser As String, ByVal strPass As String)
'usage
'FtpDownload "/TEST/test.html", "c:\test.html", "ftp.server.com", 21, "user", "password"
Dim hOpen As Long
Dim hConn As Long
hOpen = InternetOpenA("FTPGET", 1, vbNullString, vbNullString, 1)
hConn = InternetConnectA(hOpen, strHost, lngPort, strUser, strPass, 1, 0, 2)
If FtpGetFileA(hConn, strRemoteFile, strLocalFile, 1, 0, FTP_TRANSFER_TYPE_UNKNOWN Or INTERNET_FLAG_RELOAD, 0) Then
Debug.Print "done"
NA = MsgBox("Done", vbOKOnly + vbInformation, "FTP transfert")
Else
Debug.Print "fail"
NA = MsgBox("Fail", vbOKOnly + vbCritical, "FTP transfert")
End If
InternetCloseHandle hConn
InternetCloseHandle hOpen
End Function
the remote files I would like to download are in the path :
/tmp/SLX2088-101005_25-Mar-2017_13_24_25.txt
i would like to use an expression to find and download the file.
SLX2088- is invariable
101005 is unique id that i will use in variable to find the file.
so my expression will be RemoteFileName:="SLX2088-" & id & "*.txt". this expression works locally but not on ftp.
I would therefore like to first write an expression that allows me to find the file with the identifier inserted in a num_id variable and then be able to use this expression in my FtpDownload function to download the file.
can someone help me build the expression and tell me how to use it in the function?
HostName = "**.**.***.**"
UserName = "****"
Password = "****"
RemoteFileName = "/../../../tmp/SLX2088-101005_25-Mar-2017_13_24_25.txt"
LocalFileName = "C:\temp\SLX2088-101005_25-Mar-2017_13_24_25.txt"
NA = FtpDownload(RemoteFileName, LocalFileName, HostName, 21, UserName, Password)
I found the solution thank you for your help. here is the code:
Global num_inspection
Global ligne_inspection
Global actual_wkb
Const MAX_PATH = 260
Dim fichier_actu As String
Dim set_mask As String
Dim level As String
Dim entity As String
Dim hFind As Long, lRet As Long
Private Const FTP_TRANSFER_TYPE_UNKNOWN As Long = 0
Private Const INTERNET_FLAG_RELOAD As Long = &H80000000
Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public 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
Public Declare PtrSafe Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" _
(ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
Private Declare PtrSafe Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" _
(ByVal hFtpSession As Long, ByVal lpszSearchFile As String, lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal dwContent As Long) As Long
Private Declare PtrSafe Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" (ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long
Private Declare PtrSafe Function InternetOpenA Lib "wininet.dll" ( _
ByVal sAgent As String, _
ByVal lAccessType As Long, _
ByVal sProxyName As String, _
ByVal sProxyBypass As String, _
ByVal lFlags As Long) As Long
Private Declare PtrSafe Function InternetConnectA Lib "wininet.dll" ( _
ByVal hInternetSession As Long, _
ByVal sServerName As String, _
ByVal nServerPort As Long, _
ByVal sUsername As String, _
ByVal sPassword As String, _
ByVal lService As Long, _
ByVal lFlags As Long, _
ByVal lcontext As Long) As Long
Private Declare PtrSafe Function FtpGetFileA Lib "wininet.dll" ( _
ByVal hConnect As Long, _
ByVal lpszRemoteFile As String, _
ByVal lpszNewFile As String, _
ByVal fFailIfExists As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal dwFlags As Long, _
ByVal dwContext As Long) As Long
Private Declare PtrSafe Function InternetCloseHandle Lib "wininet" ( _
ByVal hInet As Long) As Long
Dim pData As WIN32_FIND_DATA
Sub testFTP()
HostName = "********"
UserName = "****"
Password = "****"
RemoteFileName = "file expression like *.*"
LocalFileName = "yourLocalFileName"
NA = FtpDownload(RemoteFileName, LocalFileName, HostName, 21, UserName, Password)
'Workbooks.OpenText Filename:="yourLocalFileName", _
Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, _
Comma:=False, Space:=True, Other:=True, OtherChar:=";", FieldInfo:= _
Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1))
End Sub
Function FtpDownload(ByVal strRemoteFile As String, ByVal strLocalFile As String, ByVal strHost As String, ByVal lngPort As Long, ByVal strUser As String, ByVal strPass As String)
Dim hOpen As Long
Dim hConn As Long
hOpen = InternetOpenA("FTPGET", 1, vbNullString, vbNullString, 1)
hConn = InternetConnectA(hOpen, strHost, lngPort, strUser, strPass, 1, 0, 2)
Call FtpSetCurrentDirectory(hConn, "here your remote directory")
pData.cFileName = String(MAX_PATH, 0)
hFind = FtpFindFirstFile(hConn, strRemoteFile, pData, 0, 0)
If FtpGetFileA(hConn, pData.cFileName, strLocalFile, 1, 0, FTP_TRANSFER_TYPE_UNKNOWN Or INTERNET_FLAG_RELOAD, 0) Then
Debug.Print "done"
NA = MsgBox("Done", vbOKOnly + vbInformation, "FTP transfert")
Else
Debug.Print "fail"
NA = MsgBox("Fail", vbOKOnly + vbCritical, "FTP transfert")
End If
InternetCloseHandle hConn
InternetCloseHandle hOpen
End Function
I have an excel workbook and want to copy another excel file from the local memory and save it to ftp server folder.
I found example code here here
The file which I want to transfer is following:
C:\Users\User1\test.xlsx
The folder to which I want to transfer is accessible via:
ftp://user:password#www.name/destination/
ftp = "85.253.158.128" I retrieved from https://www.myip.com/ (I tried both my IP and HOST)
My code is following:
Declare PtrSafe Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" ( _
ByVal hInternetSession As Long, ByVal sServerName As String, _
ByVal nServerPort As Integer, ByVal sUserName As String, _
ByVal sPassword As String, ByVal lService As Long, _
ByVal lFlags As Long, ByVal lContext As Long) As Long
Declare PtrSafe Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" ( _
ByVal sAgent As String, ByVal lAccessType As Long, _
ByVal sProxyName As String, _
ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Declare PtrSafe Function FtpSetCurrentDirectory Lib "wininet.dll" Alias _
"FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, _
ByVal lpszDirectory As String) As Boolean
Declare PtrSafe Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" ( _
ByVal hConnect As Long, _
ByVal lpszLocalFile As String, _
ByVal lpszNewRemoteFile As String, _
ByVal dwFlags As Long, _
ByRef dwContext As Long) As Boolean
Sub simpleFtpFileUpload()
Dim ftp, FTP_PORT, user, password, loc_file, remote_file, ftp_folder As Variant
ftp_folder = "ftp://user#www.name/destination"
loc_file = "C:\Users\User1\test.xlsx"
remote_file = ftp_folder & "/test.xlsx"
FTP_PORT = 21
user = "usr"
password = "pwd"
ftp = "85.253.158.128" '"192.168.1.110"
Internet_OK = InternetOpen("", 1, "", "", 0)
If Internet_OK Then
FTP_OK = InternetConnect(Internet_OK, ftp, FTP_PORT, user, password, 1, 0, 0) ' INTERNET_DEFAULT_FTP_PORT or port no
If FtpSetCurrentDirectory(FTP_OK, "/") Then
Success = FtpPutFile(FTP_OK, loc_file, remote_file, FTP_TRANSFER_TYPE_BINARY, 0)
End If
End If
If Success Then
Debug.Print "ftp success ;)"
MsgBox "ftp success ;)"
Else
Debug.Print "ftp failure :("
MsgBox "ftp failure :("
End If
End Sub
I always got an error "ftp failure :(". Could you help to solve this problem? I am also using VPN, may it trigger the problem?
UPDATE:
Is it also possible to do something like below, because DestFile shows the path on the disc :
Sub simpleFtpFileUpload()
Dim SoureFile As String
Dim DestFile As String
SourceFile = "C:\Users\User1\test.xlsx"
DestFile = "ftp://user:password#www.name/destination/test.xlsx"
FileCopy SourceFile, DestFile
End Sub
With this approach I got an error
and FileCopy SourceFile, DestFile row is highlighted when I press Debug button.
I have code that loops through a list of hyperlinks in Excel and batch downloads these links as PDFs.
Sometimes they save to my desktop, documents, or another file path.
I would like them saved to a designated folder on my desktop named "PDFs."
Declare PtrSafe 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
Function DownloadFile(URL As String, LocalFilename As String) As Boolean
Dim lngRetVal As Long
lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
If lngRetVal = 0 Then DownloadFile = True
End Function
Sub DownloadPDFs()
Dim StartRowNum As Long
Dim EndRowNum As Long
Dim pdfname As String
Dim RecordNum As String
Dim URLprefix As String
LastRowPDF = Sheet1.Cells(Rows.Count, "B").End(xlUp).Row
For i = 2 To LastRowPDF
Application.ScreenUpdating = False
URLprefix = Sheet1.Cells(i, 2)
RecordNum = Sheet1.Cells(i, 3)
pdfname = RecordNum & ".pdf"
URL = URLprefix
DownloadFile URLprefix, pdfname
Application.ScreenUpdating = True
Next i
End Sub
How do I save to a specific folder path?
This is the method I use and it works well, especially if you may need to use the file on multiple computers where the user profile may change, for example sending to others to execute the print operation or printing from another desktop. This method does not set a static path specific to your PC, but rather a path according to the PC it is being run on. A more flexible solution.
'Set Filename
pdfname = Environ("UserProfile") & "\Desktop\PDFs\" & RecordNum & ".pdf"
I have found the code below to start me off with developing a automated way to download files from an ftp site. however it fails every time without any error that i can troubleshoot.
I have a newbie in excel vba so some help would be appreciated.
I have tried searching online and here at stack overflow but I could'nt figure this out on my own
Private Const FTP_TRANSFER_TYPE_UNKNOWN As Long = 0
Private Const INTERNET_FLAG_RELOAD As Long = &H80000000
Private Declare Function InternetOpenA Lib "wininet.dll" ( _
ByVal sAgent As String, _
ByVal lAccessType As Long, _
ByVal sProxyName As String, _
ByVal sProxyBypass As String, _
ByVal lFlags As Long) As Long
Private Declare Function InternetConnectA Lib "wininet.dll" ( _
ByVal hInternetSession As Long, _
ByVal sServerName As String, _
ByVal nServerPort As Long, _
ByVal sUsername As String, _
ByVal sPassword As String, _
ByVal lService As Long, _
ByVal lFlags As Long, _
ByVal lcontext As Long) As Long
Private Declare Function FtpGetFileA Lib "wininet.dll" ( _
ByVal hConnect As Long, _
ByVal lpszRemoteFile As String, _
ByVal lpszNewFile As String, _
ByVal fFailIfExists As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal dwFlags As Long, _
ByVal dwContext As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet" ( _
ByVal hInet As Long) As Long
Sub FtpDownload(ByVal strRemoteFile As String, ByVal strLocalFile As String, ByVal strHost As String, ByVal lngPort As Long, Optional ByVal strUser As String, Optional ByVal strPass As String)
Dim hOpen As Long
Dim hConn As Long
hOpen = InternetOpenA("FTPGET", 1, vbNullString, vbNullString, 1)
hConn = InternetConnectA(hOpen, strHost, lngPort, strUser, strPass, 1, 0, 2)
If FtpGetFileA(hConn, strRemoteFile, strLocalFile, 1, 0, FTP_TRANSFER_TYPE_UNKNOWN Or INTERNET_FLAG_RELOAD, 0) Then
Debug.Print "Success"
Else
Debug.Print "Fail"
End If
'Close connections
InternetCloseHandle hConn
InternetCloseHandle hOpen
End Sub
Sub Get_File_From_FTP()
'Assign Host URL, Source and Destination File path
Dim HostURL, fileSource, FileDestination As String
HostURL = ThisWorkbook.Sheets(1).Cells(1, 1)
fileSource = ThisWorkbook.Sheets(1).Cells(1, 2)
FileDestination = ThisWorkbook.Sheets(1).Cells(2, 2)
FtpDownload fileSource, FileDestination, HostURL, 21, "Username", "Password"
End Sub
Okay, the above code works without any problems. I believe the problem might be within your reference cells...
HostURL = ThisWorkbook.Sheets(1).Cells(1, 1)
fileSource = ThisWorkbook.Sheets(1).Cells(1, 2)
FileDestination = ThisWorkbook.Sheets(1).Cells(2, 2)
When i messed around with this, i found that I had to have this format...
HostURL = "192.168.168.2" 'Or your FQDN
fileSource = "/This/Is/The/Path/To/Your/File.file" ' Make sure that this matches your file path
FileDestination = "C:\This\Is\The\Complete\Path\On\Your\Machine.File"
Of course, make sure that you populate the username and password section of the macro...
FtpDownload fileSource, FileDestination, HostURL, 21, "YOUR_USERNAME_HERE", "YOUR_PASSWORD_HERE"
Dim HostURL, fileSource, FileDestination As String
HostURL = "ftp.datacentre.com"
fileSource = "/country_forecast/CWG_ecop_19021012_United-Kingdom.csv"
FileDestination = "C:\Development\Test1\newFile.txt"
FtpDownload fileSource, FileDestination, HostURL, 21, "username", "password"
I have tried everything now. so I'm using the above paths.
This url works though I i download the file manually. [ftp://username:password#ftp.datacentre.com/country_forecast/CWG_ecop_19021012_United-Kingdom.csv]
I am trying to make a function check if a .pdf file exists. If it exists I want to print the file.
Function PrintPDF(PartNum As String)
Dim DirFile As String
DirFile = "\\SERVER5\hpfiles\Company\Drawings\PDF-SL8\" & PartNum & ".pdf"
If Dir(DirFile) = "" Then
Exit Function
Else
DirFile.PrintOut
End If
End Function
I get a compile error saying Invalid Qualifier. I assume its because DirFile is a string.
How do I use this string as the targeted file for printing?
Correct, you can't print a string. One way is to use a shell command and print the file like this:
Option Explicit
Declare Function apiShellExecute 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 Sub PrintFile(ByVal strPathAndFilename As String)
Call apiShellExecute(Application.hwnd, "print", strPathAndFilename, vbNullString, vbNullString, 0)
End Sub
Function PrintPDF(PartNum As String)
Dim DirFile As String
DirFile = "\\SERVER5\hpfiles\Company\Drawings\PDF-SL8\" & PartNum & ".pdf"
If Dir(DirFile) = "" Then Exit Function
PrintFile (DirFile)
End Function
Adapted from this post