Download from FTP

[mwheatley]

Hi

I have the code below attached to a button in a macro. This is the code in complete and I have been using it to test taking the information from a file on my computer. This works fine, it all plugs in to the right place - no issue.

Now that file is on my ftp server which is user and password protected. *I have literally no idea how to go about downloading or (preferably) opening this file from the ftp*

Could anyone help me out with how to download my file?


Sub ImportTextFile()

Application.ScreenUpdating = False


Password = "ABC"
UserName = "ABC"
Filename = "ABC"
Serverlocation = "ftp:www abc com\"


INSERT CODE TO DOWNLOAD FILE FROM FTP SERVER HERE






myTextFile = Workbook.Open(-------)


Dim lastCol As Long
lastCol = ThisWorkbook.Sheets("Continuity").Cells(4, Columns.Count).End(xlToLeft).Column

myTextFile.Sheets(1).Range("A4:A11").Copy
ThisWorkbook.Sheets("Continuity").Cells(4, lastCol + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

If myTextFile.Sheets(1).Range("A5") = ThisWorkbook.Sheets("Continuity").Cells(5, lastCol) Then
ThisWorkbook.Sheets("Continuity").Cells(4, lastCol + 1).ClearContents
ThisWorkbook.Sheets("Continuity").Cells(5, lastCol + 1).ClearContents
ThisWorkbook.Sheets("Continuity").Cells(6, lastCol + 1).ClearContents
ThisWorkbook.Sheets("Continuity").Cells(7, lastCol + 1).ClearContents
ThisWorkbook.Sheets("Continuity").Cells(8, lastCol + 1).ClearContents
ThisWorkbook.Sheets("Continuity").Cells(9, lastCol + 1).ClearContents
ThisWorkbook.Sheets("Continuity").Cells(10, lastCol + 1).ClearContents
ThisWorkbook.Sheets("Continuity").Cells(11, lastCol + 1).ClearContents


End If


myTextFile.Close = False
Application.ScreenUpdating = True

End Function

[Kenneth Hobs]

Welcome to the forum!

If you know how to code to upload a file, downloading is similar. The two methods used by most are BAT file method and API. This is the latter. I have not tested since I don't have access for an ftp site to read/write.

Put this into a Module and call the routine to upload or download as needed.

'http://msenthil.tripod.com/new/tipgn5.html
' Opens a HTTP/FTP session for a given site.
' Constant declarations
Public Const ERROR_INTERNET_EXTENDED_ERROR = 12003


' User agent constant.
Public Const scUserAgent = "vb wininet"


' Use registry access settings.
Public Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Public Const INTERNET_OPEN_TYPE_DIRECT = 1
Public Const INTERNET_OPEN_TYPE_PROXY = 3
Public Const INTERNET_INVALID_PORT_NUMBER = 0


Public Const FTP_TRANSFER_TYPE_BINARY = &H2
Public Const FTP_TRANSFER_TYPE_ASCII = &H1
Public Const INTERNET_FLAG_PASSIVE = &H8000000


' Brings the data across the wire even if it locally cached.
Public Const INTERNET_FLAG_RELOAD = &H80000000
Public Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
Public Const INTERNET_FLAG_MULTIPART = &H200000


' Type of service to access.
Public Const INTERNET_SERVICE_FTP = 1
Public Const INTERNET_SERVICE_GOPHER = 2
Public Const INTERNET_SERVICE_HTTP = 3




Public Declare 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


' Closes a single Internet handle or a subtree of Internet handles.
Public Declare Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Integer


' Initializes an application's use of the Win32 Internet functions
Public Declare 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


' To down load a file from the FTP server
Public Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" _
(ByVal hFtpSession As Long, ByVal lpszRemoteFile As String, _
ByVal lpszNewFile As String, ByVal fFailIfExists As Boolean, ByVal dwFlagsAndAttributes As Long, _
ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean


' To up load a file from the FTP server
Public Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" _
(ByVal hFtpSession As Long, ByVal lpszLocalFile As String, _
ByVal lpszRemoteFile As String, _
ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean


' To change current directory in the remote server
Public Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" _
(ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean


' To get response information from the server
Public Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" ( _
lpdwError As Long, _
ByVal lpszBuffer As String, _
lpdwBufferLength As Long) As Boolean




Private Function DownLoadFile(sFTPSrvr As String, sDirName As String, sLogin As String, sPassword _
As String, sFn As String, sTarget As String) As Boolean


Dim sMsgstr As String
Dim sErrorStr As String
Dim hOpen As Long, hConnection As Long
Dim bRet As Boolean
Dim nFlag As Long


On Error GoTo DownLoaderror

DownLoadFile = False

'--Open session
hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
If hOpen = 0 Then
sErrorStr = ErrorDisplay("InternetOpen")
GoTo DownLoaderror
End If

nFlag = 0
'--make connection with the host
hConnection = InternetConnect(hOpen, sFTPSrvr, INTERNET_INVALID_PORT_NUMBER, sLogin, _
sPassword, INTERNET_SERVICE_FTP, nFlag, 0)
If hConnection = 0 Then
sErrorStr = ErrorDisplay("InternetConnect")
GoTo DownLoaderror
End If

'--change the directory
If sDirName <> "" Then
bRet = FtpSetCurrentDirectory(hConnection, sDirName)
If bRet = False Then
sErrorStr = ErrorDisplay("FtpSetCurrentDirectory")
GoTo DownLoaderror
End If
End If


'--get file from host
bRet = FtpGetFile(hConnection, sFn, sTarget, False, INTERNET_FLAG_RELOAD, _
FTP_TRANSFER_TYPE_ASCII, 0)
If bRet = False Then
sErrorStr = ErrorDisplay("FtpGetFile")
GoTo DownLoaderror
End If


'--close connection and session
If hConnection Then InternetCloseHandle hConnection
If hOpen Then InternetCloseHandle hOpen


DownLoadFile = True
Exit Function


DownLoaderror:
DownLoadFile = False
sMsgstr = "Error while down loading file " & sFn & " from the host " & sFTPSrvr & Chr(13)
sMsgstr = sMsgstr & Chr(13) & "Error No: " & Err & " " & Error & Chr(13)
sMsgstr = sMsgstr & Chr(13) & "Response from host:" & Chr(13) & sErrorStr
MsgBox sMsgstr, vbExclamation, "Error"


If hConnection Then InternetCloseHandle hConnection
If hOpen Then InternetCloseHandle hOpen
Exit Function
End Function


Private Function ErrorDisplay(sCalledFunction As String) As String
Dim dwIntError As Long, dwLength As Long
Dim strBuffer As String

'Invoke the function to find out the length of the error message
InternetGetLastResponseInfo dwIntError, vbNullString, dwLength
strBuffer = String(dwLength + 1, 0)

'Invoke the function again to get the error message
InternetGetLastResponseInfo dwIntError, strBuffer, dwLength
ErrorDisplay = "Error in function:" & sCalledFunction & " " & dwIntError & " " & strBuffer
End Function


Private Function UpLoadFile(sFTPSrvr As String, sDirName As String, sLogin As String, sPassword _
As String, sFn As String, sTarget As String) As Boolean


Dim sMsgstr As String
Dim sErrorStr As String
Dim hOpen As Long, hConnection As Long
Dim bRet As Boolean
Dim nFlag As Long


On Error GoTo UpLoaderror

'DownLoadFile = False

'--Open session
hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
If hOpen = 0 Then
sErrorStr = ErrorDisplay("InternetOpen")
GoTo UpLoaderror
End If

nFlag = 0
'--make connection with the host
hConnection = InternetConnect(hOpen, sFTPSrvr, INTERNET_INVALID_PORT_NUMBER, sLogin, _
sPassword, INTERNET_SERVICE_FTP, nFlag, 0)
If hConnection = 0 Then
sErrorStr = ErrorDisplay("InternetConnect")
GoTo UpLoaderror
End If

'--change the directory
If sDirName <> "" Then
bRet = FtpSetCurrentDirectory(hConnection, sDirName)
If bRet = False Then
sErrorStr = ErrorDisplay("FtpSetCurrentDirectory")
GoTo UpLoaderror
End If
End If


'--copy the file in host
bRet = FtpPutFile(hConnection, sFn, sTarget, FTP_TRANSFER_TYPE_ASCII, 0)
If bRet = False Then
sErrorStr = ErrorDisplay("FtpPutFile")
GoTo UpLoaderror
End If


'--close connection and session
If hConnection Then InternetCloseHandle hConnection
If hOpen Then InternetCloseHandle hOpen


'DownLoadFile = True
Exit Function


UpLoaderror:
'DownLoadFile = False
sMsgstr = "Error while down uploading file " & sFn & " from the host " & sFTPSrvr & Chr(13)
sMsgstr = sMsgstr & Chr(13) & "Error No: " & Err & " " & Error & Chr(13)
sMsgstr = sMsgstr & Chr(13) & "Response from host:" & Chr(13) & sErrorStr
MsgBox sMsgstr, vbExclamation, "Error"


If hConnection Then InternetCloseHandle hConnection
If hOpen Then InternetCloseHandle hOpen
Exit Function
End Function

[snb]

in Excel you can add an FTP site & password in the openfile dialog window.

Once you have opened that ftp-location with your password by means of that window you can use the full address in VBA


Sub M_snb()
workbooks.open "ftp://www.snb-vba.eu/domains/snb-vba.eu/public_html/bestanden/__duplicates_snb.xlsb"
end sub

But since this file is publicly available on the website you can also use:


Sub M_snb()
workbooks.open "http://www.snb-vba.eu/domains/snb-vba.eu/public_html/bestanden/__duplicates_snb.xlsb"
end sub

[mwheatley]

Thanks for the quick replies

I had tried the Workbook.open but it keeps throwing 1004 errors at me, and not even giving me the chance to enter my details, even when I include the username and password in the FTP line in the macro.

[snb]

Please reread the first 2 lines of my answer and act accordingly.

[Kenneth Hobs]

You can use this site to test what snb said by: File > Open > Browse > ftp://ftp.swfwmd.state.fl.us/pub > Open
Click Anonymous and enter your email as the password and save the password box. Some ftp anonymous logins allow fake emails for passwords but I don't do that. At this site, you would upload to incoming and download from outgoing.

Using snb's method, be sure to select the option to show all file types and be patient once you click the Open button to open the ftp site.

I don't see the purpose in GUI which negates automation. If I were to use GUI, I would use WSFTPLite, WSFTPpro, ftpCute, or other FTP GUI software. Some of these offer batch options. Normally, I like to create a BAT file for automated upload/download to websites more than ftp sites these days. Of course VBA can make that file. e.g.


'http://stackoverflow.com/questions/7737691/upload-file-via-ftp-from-excel-vba
Sub FtpFileto()
Dim fso As Object, f$
Set fso = CreateObject("scripting.filesystemobject")
f = "C:\t\FTPScript.txt"
' Create the ftpscript to be run


Open f For Output As #1
Print #1, "open ftp.server.com" 'replace ftp.server with the server address
Print #1, "ID" 'login id here
Print #1, "PWD" 'login password here
Print #1, "quote pasv" ' passive mode ftp if needed
Print #1, "cd " & " /dir" 'Directory of file location
Print #1, "cd " & " subdir" 'Sub-Directory of file location
Print #1, "ascii"
Print #1, "prompt"
'Put the file from the host and save it to the specified directory and filename
'Print #1, "put " & VREDET; """C:\file1.csv"""; ""
'Print #1, "put " & VREDET; """C:\file2.csv"""; ""
'Print #1, "put " & VREDET; """C:\file3.csv"""; ""
Print #1, "disconnect" 'disconnect the session
Print #1, "bye"
Print #1, "exit"
Close #1
'Now for the command to upload to the ftpsite and log it to a text file
' the trick is to use the standard command shell which allows logging


Shell "cmd /c C:\WINDOWS\system32\ftp.exe -i -s:C:\FTPScript.txt > c:\ftpuploadlog.txt", vbHide


End Sub

[mwheatley]

Thanks for the help so far guys. The solutions should work from what I can see, but I keep getting 2 attempts at access when the password and username are entered, and then it errors that the web address is not valid - *it is*