PDA

View Full Version : VBA code to search & open file in FTP directory



londoner
03-27-2009, 04:08 PM
I am trying to write a VBA Excel macro which will open up a password protected FTP site, search for an Excel file and open it, before doing further operations on it.

I have got as far as writing a macro which will open the FTP site and enter in a username and password and enter into the relevant directory.

However I am now stuck on how to get it to find the relevant file and open it in Excel.

Does anyone know the VBA code for searching through files in a folder until the relevant one is found, and opening it?

I have found how to do this for a file saved on the computer, but unfortunately it doesn't seem to work for a file saved on FTP site.

Many thanks!

Kenneth Hobs
03-27-2009, 06:54 PM
Welcome to the forum!

One way is to send FTP commands through a BAT file. Use the DOS redirection symbol ">" to capture the output from ftp sent commands to at text file. It would take some time for me to test some things to show working code for you. One has to use API methods like ExecCmd to make it wait for the BAT file to close. For Unix ftp servers, ls, is what you would send.

Once you have the text file, you can read it to get what you need. For the BAT file method see http://www.bygsoftware.com/Excel/VBA/ftp.htm

For an object method see http://vbaexpress.com/forum/showthread.php?t=960

londoner
03-28-2009, 04:44 AM
Kenneth,

Many thanks for the links.

However, when I try to run the code in the object method above, I get the error 'user defined variable not defined' on Inet...I'm new-ish to VBA and have no idea what is causing this error, any ideas?

Kenneth Hobs
03-29-2009, 11:30 AM
You could add the reference in VBE's Tools > References.

If you don't have it, you can search for msinet.ocx to find it at sites like:
http://www.ocxdump.com/download-ocx-files_new.php/ocxfiles/M/MSINET.OCX/6.01.9782/download.html


I think this will work better. Add a Userform. In the Toolbox dialog, right click and add the control. Drag that control and drop to your Userform. In the Module, do something like:


Sub ftptest()
MsgBox DownloadFile("ftp://ftp-www.earthlink.net/webdocs", _
"khobson@aaaahawk.com", "MySuperSecretPassword", _
"index.html", _
"C:\Temp\index.html")
End Sub

'Requires Reference: MSINET.OCX in Microsoft Internet Transfer Control
Function DownloadFile(ByVal HostName As String, _
ByVal UserName As String, _
ByVal Password As String, _
ByVal RemoteFileName As String, _
ByVal LocalFileName As String) As String
'Dim FTP As InetCtlsObjects.Inet
'Set FTP = New InetCtlsObjects.Inet
'With FTP
Load UserForm1
With UserForm1.Inet1
.URL = HostName
.Protocol = 2
.UserName = UserName
.Password = Password
.Execute , "Get " + RemoteFileName + " " + LocalFileName
Do While .StillExecuting
DoEvents
Loop
DownloadFile = .ResponseInfo
End With
Unload UserForm1
'Set FTP = Nothing
End Function

Kenneth Hobs
03-29-2009, 12:06 PM
For examples using Inet1, see: http://msdn.microsoft.com/en-us/library/aa733648(VS.60).aspx (http://msdn.microsoft.com/en-us/library/aa733648%28VS.60%29.aspx)

Here is one way to get your dir info.

Sub Test_GetDir()
MsgBox GetDir("ftp://ftp-www.earthlink.net/webdocs", _
"khobson@aaaahawk.com", "MySuperSecretPassword")
End Sub

Function GetDir(ByVal HostName As String, _
ByVal UserName As String, _
ByVal Password As String) As String
Dim vtData As Variant, s As String
Load UserForm1
With UserForm1.Inet1
.URL = HostName
.Protocol = icFTP '2
.UserName = UserName
.Password = Password
.Execute , "dir *.*"
Do While .StillExecuting
DoEvents
Loop
' Get the first chunk. NOTE: specify a Byte
' array (icByteArray) to retrieve a binary file.
vtData = .GetChunk(1024, icString)
Do While LenB(vtData) > 0
s = s & vtData
' Get next chunk.
vtData = .GetChunk(1024, icString)
Loop
GetDir = s
.Execute , "Close"
End With
Unload UserForm1
End Function

londoner
03-29-2009, 12:07 PM
I'm now getting this error...

"Compile error: Method or data member not found".

Any ideas? Thanks so much

Kenneth Hobs
03-29-2009, 12:15 PM
Sounds like you did not add the Inet1 control to Userform1 as I explained.

londoner
03-29-2009, 01:09 PM
Sounds like you did not add the Inet1 control to Userform1 as I explained.

Kenneth - thanks for your efforts. im quite new to VBA and don't quite understand where to put the various code. I opened up a userform and then added a commandbutton on it. But then do i just put all that code into the commandbutton sub?

If so, how does the userform open up when I run the macro?

Might be easier if ur on msn messenger? I will send you my email by pvt msg if its OK?

Thanks!

Kenneth Hobs
03-29-2009, 01:28 PM
With the Toolbox open, select Tools > Additional Controls and add the Microsoft Internet Transfer Control, version 6.0. This is the control that you add to the userform, not a CommandButton control.

This example (http://www.excelguru.ca/node/85) shows how to add a TreeView control. A similar method is used for the Microsoft Internet Transfer Control.

What we do is add the one control to a userform and then play a module's Test sub. The Load command loads the userform letting use the controls. Of course if you really want to show the userform, this can be done instead.

See the attachment as an example using what I posted earlier.

londoner
03-29-2009, 02:20 PM
Kenneth - thanks for that. I'm slowly but surely learning my way there!

I'm just getting this error now:

Run-time error '35754'
Unable to connect to remote host

It occurs on this line of the code:

.Execute , "ls *.*"

What does this line actually do? Maybe I don't need it?

londoner
03-29-2009, 02:27 PM
Kenneth - thanks for that. I'm slowly but surely learning my way there!

I'm just getting this error now:

Run-time error '35754'
Unable to connect to remote host

It occurs on this line of the code:

.Execute , "ls *.*"

What does this line actually do? Maybe I don't need it?

I've re-downloaded your file and changed FTP details to the one I need.

I now get this error (I have deleted out the filename as it is sensitive).

Kenneth Hobs
03-29-2009, 02:42 PM
Either your ftp site or your logon info is wrong most likely. If the connection was successful, you can use this to return the name of the site.


DownloadFile = .RemoteHost
Try connecting with a program like wsftp to verify your site, username and password.

I use Dir but ls will usually work as well. It returns the list of files. It lists the ftp site's files that you logged into. I thought was what you wanted.

Of course you can always just download the file if it did not exist then the file that you put it in would not exist. VBA's DIR() can be used to see if a file exists.

I would just go ahead and try to get the file. You can use Kill() to delete the local file before trying to Get the remote file.

londoner
03-29-2009, 02:49 PM
Either your ftp site or your logon info is wrong most likely. If the connection was successful, you can use this to return the name of the site.

DownloadFile = .RemoteHost

Try connecting with a program like wsftp to verify your site, username and password.

I do get a messagebox with the name of the ftp site. So I'm not sure why the original code doesn't download the file to my local location?

Just to check - the RemoteFileName should be the name of the file as saved on the FTP site?

and the LocalFileName should be the path (including name) that I want to save it under?

Thanks!

Kenneth Hobs
03-29-2009, 03:17 PM
Yes, the file must exist at the remote site and your drive and folder must exist on the local drive. Parameter 4 is the site's filename and parameter 5 is the local name to download it to.

Sub ftptest()
MsgBox DownloadFile("ftp://ftp-www.earthlink.net/webdocs", _
"khobson@aaaahawk.com", "MySuperSecretPassword", _
"index.html", _
"C:\Temp\index.html")
End Sub
In this one, index.html resides in the webdocs folder of the site ftp-www.earthlink.net. The local drive and path would be: c:\temp\index.html. You do not have to name the local file the same as the other though I typically do.

The Sub Test_GetDir lists all of the files in the folder of the remote site.

Here is another way to see if your remote file exists.

Sub Test2_GetDir()
Dim aFile As String
aFile = GetDir("ftp://ftp-www.earthlink.net/webdocs", _
"khobson@aaaahawk.com", "KensSuperSecretPassword")
MsgBox InStr(aFile, "index.html") > 0
End Sub

Function GetDir(ByVal HostName As String, _
ByVal UserName As String, _
ByVal Password As String) As String
Dim vtData As Variant, s As String
Load UserForm1
With UserForm1.Inet1
.URL = HostName
.Protocol = icFTP '2
.UserName = UserName
.Password = Password
.Execute , "dir index.html"
Do While .StillExecuting
DoEvents
Loop
' Get the first chunk. NOTE: specify a Byte
' array (icByteArray) to retrieve a binary file.
vtData = .GetChunk(1024, icString)
Do While LenB(vtData) > 0
s = s & vtData
' Get next chunk.
vtData = .GetChunk(1024, icString)
Loop
GetDir = s
.Execute , "Close"
End With
Unload UserForm1
End Function

londoner
03-29-2009, 03:25 PM
I've tried running that code but it just runs for a long time (hourglass) and returns nothing.

I know that the file exists because i can log-in to the directory manually and see it there...

Kenneth Hobs
03-30-2009, 05:37 AM
You have something other than mine as mine works at home but not at work. Maybe you are behind a firewall that uses a proxy server?

The GetDir() shows all the files in the remote server's path, providing it connects.

If you can find a site that has some files that we can test, let me know. There should be some anonymous sites. If I get time, I will look for one so that we can be on the same page.

londoner
03-30-2009, 01:19 PM
You have something other than mine as mine works at home but not at work. Maybe you are behind a firewall that uses a proxy server?

The GetDir() shows all the files in the remote server's path, providing it connects.

If you can find a site that has some files that we can test, let me know. There should be some anonymous sites. If I get time, I will look for one so that we can be on the same page.

I'd appreciate that as I'm kind of struggling with this now....

Thanks!

Kenneth Hobs
03-30-2009, 01:31 PM
Are you behind a firewall? The Inet control has a .Proxy property but it does not work for our proxy.

I am at work so I will have to test this at home.


Sub Test_DownloadFile1()
MsgBox DownloadFile("ftp://ftp.simtel.net/pub/simtelnet/msdos/info", _
"anonymous", "khobson@aaaahawk.com", _
"ftp-list.zip", _
"ftp-list.zip")
'Username is anonymous or ftp.
'Password is your email address for courtesy.
Shell "cmd /c c:\temp\ftp-list.zip", vbNormalFocus
End Sub

Kenneth Hobs
03-30-2009, 05:31 PM
This works on mine at home. This first parts shows all of the files in a MsgBox which will be much larger than the screen can show. The second part gets a file, puts it in your c:\temp folder and opens it.

I doubt this would work behind a corporate firewall.


Sub Test_GetDir1()
MsgBox GetDir1("ftp.simtel.net", "pub/simtelnet/msdos/info")
End Sub

Function GetDir1(ByVal HostName As String, _
Optional ByVal subfolder As String = "", _
Optional ByVal UserName As String = "anonymous", _
Optional ByVal Password As String = "khobson@aaaahawk.com") As String
Dim vtData As Variant, s As String
Load UserForm1
With UserForm1.Inet1
.URL = HostName
.Protocol = icFTP '2
.UserName = UserName
.Password = Password
.Execute , "cd " & subfolder
Do While .StillExecuting
DoEvents
Loop
.Execute , "dir *.*"
Do While .StillExecuting
DoEvents
Loop
' Get the first chunk. NOTE: specify a Byte
' array (icByteArray) to retrieve a binary file.
vtData = .GetChunk(1024, icString)
Do While LenB(vtData) > 0
s = s & vtData
' Get next chunk.
vtData = .GetChunk(1024, icString)
Loop
GetDir1 = s
.Execute , "Close"
End With
Unload UserForm1
End Function


Sub Test_DownloadFile1()
MsgBox DownloadFile("ftp://ftp.simtel.net", _
"/pub/simtelnet/msdos/info/ftp-list.zip", _
"C:\Temp\ftp-list.zip")
'Username is anonymous or ftp.
'Password is your email address for courtesy.
Shell "cmd /c C:\Temp\ftp-list.zip", vbNormalFocus
End Sub

'Requires Reference: MSINET.OCX in Microsoft Internet Transfer Control
Function DownloadFile1(ByVal HostName As String, _
ByVal RemoteFileName As String, _
ByVal LocalFileName As String, _
Optional ByVal UserName As String = "anonymous", _
Optional ByVal Password As String = "khobson@aaaahawk.com", _
Optional ByVal ProxyServer As String = "") As String
Dim vtData As Variant
Load UserForm1
With UserForm1.Inet1
'.AccessType = icNamedProxy
.Proxy = ProxyServer
.URL = HostName
.Protocol = icFTP '2
.UserName = UserName
.Password = Password
.Execute , "Get " + RemoteFileName + " " + LocalFileName
Do While .StillExecuting
DoEvents
Loop
DownloadFile1 = .ResponseInfo
.Execute , "Close"
End With
Unload UserForm1
End Function

londoner
04-01-2009, 01:54 PM
This works on mine at home. This first parts shows all of the files in a MsgBox which will be much larger than the screen can show. The second part gets a file, puts it in your c:\temp folder and opens it.

I doubt this would work behind a corporate firewall.

Sub Test_GetDir1()
MsgBox GetDir1("ftp.simtel.net", "pub/simtelnet/msdos/info")
End Sub

Function GetDir1(ByVal HostName As String, _
Optional ByVal subfolder As String = "", _
Optional ByVal UserName As String = "anonymous", _
Optional ByVal Password As String = "khobson@aaaahawk.com") As String
Dim vtData As Variant, s As String

Load UserForm1
With UserForm1.Inet1
.URL = HostName
.Protocol = icFTP '2
.UserName = UserName
.Password = Password
.Execute , "cd " & subfolder
Do While .StillExecuting
DoEvents
Loop
.Execute , "dir *.*"
Do While .StillExecuting
DoEvents
Loop

' Get the first chunk. NOTE: specify a Byte
' array (icByteArray) to retrieve a binary file.
vtData = .GetChunk(1024, icString)
Do While LenB(vtData) > 0
s = s & vtData
' Get next chunk.
vtData = .GetChunk(1024, icString)
Loop

GetDir1 = s
.Execute , "Close"
End With

Unload UserForm1
End Function
Sub Test_DownloadFile1()
MsgBox DownloadFile("ftp://ftp.simtel.net", _
"/pub/simtelnet/msdos/info/ftp-list.zip", _
"C:\Temp\ftp-list.zip")
'Username is anonymous or ftp.
'Password is your email address for courtesy.
Shell "cmd /c C:\Temp\ftp-list.zip", vbNormalFocus
End Sub

'Requires Reference: MSINET.OCX in Microsoft Internet Transfer Control
Function DownloadFile1(ByVal HostName As String, _
ByVal RemoteFileName As String, _
ByVal LocalFileName As String, _
Optional ByVal UserName As String = "anonymous", _
Optional ByVal Password As String = "khobson@aaaahawk.com", _
Optional ByVal ProxyServer As String = "") As String

Dim vtData As Variant
Load UserForm1
With UserForm1.Inet1
'.AccessType = icNamedProxy
.Proxy = ProxyServer
.URL = HostName
.Protocol = icFTP '2
.UserName = UserName
.Password = Password
.Execute , "Get " + RemoteFileName + " " + LocalFileName
Do While .StillExecuting
DoEvents
Loop

DownloadFile1 = .ResponseInfo
.Execute , "Close"
End With

Unload UserForm1
End Function


I've changed the FTP server, username and password to be what I need, but I keep getting the error 'Object Required' with no further details...
??

P.S the original code works fine.

Kenneth Hobs
04-01-2009, 02:26 PM
The code that you quoted worked fine? If so, then you have the OCX control set properly. Make sure that you set it for other workbooks if needed.

Getting the right servername, username and password will vary. Notice the differences in the anonymous Simtel logon and the Earthlink logon. Get an ftp program like wsftp and try logging on with it first.

Dr.K
04-01-2009, 02:39 PM
Wow... I guess this is why I use the BAT/Shell method exclusively, the Object method has always been problematic for me. This bugs me, because I generally prefer to use Object Models. BAT text files are sort of messy, but they do the job.

I actually have a function that can "look inside" CSV files on an FTP site to check an internal datestamp. It just starts the DL, waits a second, and then KILLs the Shell Process. (note, this ONLY works on text files)

Hey londoner, keep trying Hobs's code, sounds like you are pretty close. But if you give up, let me know and I can post some BAT method code for you.

Kenneth Hobs
04-01-2009, 05:01 PM
If you do a BAT file example Dr.K, the Simtel examples in post #19 would be a good way to contrast both methods. If you don't post one soon, I may post one just to complete this thread.

While I do like DOS methods, I generally have to use an API method called ExecCmd() as shells to DOS can cause timing issues.

The object method has its own issues with the ActiveX enable message nag. However, it is a fairly decent method otherwise.

Of course we can easily download a text file using this method and get what we need. Funny you should mention that as I have been considering using a text file to store version information for some files and doing that very thing. The files that I would get are on an http site so I would probably use an API method or a winHTTP method.

londoner
04-02-2009, 01:01 PM
Wow... I guess this is why I use the BAT/Shell method exclusively, the Object method has always been problematic for me. This bugs me, because I generally prefer to use Object Models. BAT text files are sort of messy, but they do the job.

I actually have a function that can "look inside" CSV files on an FTP site to check an internal datestamp. It just starts the DL, waits a second, and then KILLs the Shell Process. (note, this ONLY works on text files)

Hey londoner, keep trying Hobs's code, sounds like you are pretty close. But if you give up, let me know and I can post some BAT method code for you.


Dr K - thanks for your input. I would be grateful if you could post the code for the BAT method of downloading a file from a password protected FTP site.

I think that although I am close to getting there with the Object method, I may struggle to find the last step needed to eliminate my errors.

Many thanks again.

Kenneth Hobs
04-02-2009, 01:11 PM
The first link that I posted shows how to do it using the BAT file method.

Dr.K
04-03-2009, 08:30 AM
You know, I was thinking about this, and I've decided that using BAT files in a Shell is totally justified for FTP, becuase of how primitive FTP is. I mean, as much as I like to use Objects, windows has a built in command line tool for FTP, why bother adding a reference to an OS component?

Plus, for larger files, the Shell command-line window provides feedback about the process to the end user.

I was just looking at my subs, and I realized that they have proliferated over time. If anybody else finds this useful, I might submit it as a KB entry. Suggestions/improvements welcome.

Ok, first you need a Module for your "Shell Subs". You can use the window scripting host to run Shell commands, but here I use Windows API calls. Add a blank module, and paste this code in:


Option Explicit
Option Private Module

'API Function calls used by the Shell Subs
Private Declare Function OpenProcess Lib "kernel32" _
(ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _
ByVal dwProcessId As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long
Private Declare Function GetModuleBaseName Lib "psapi.dll" _
Alias "GetModuleBaseNameA" (ByVal hProcess As Long, _
ByVal hModule As Long, ByVal lpBaseName As String, _
ByVal nSize As Long) As Long

'Constants used by the API Function calls
Private Const WM_CLOSE = &H10
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Const STILL_ACTIVE = &H103
'

Sub ShellAndWait(PathName As String, Optional WindowState)
'ShellAndWait uses Windows API calls to force Excel to wait
'for the window opened by the Shell command to close before
'continuing to execute the VBA script.
'Window States (Per Help for Shell function):
' 1, 5, 9 Normal with focus.
' 2 Minimized with focus.
' 3 Maximized with focus.
' 4, 8 Normal without focus.
' 6, 7 Minimized without focus.
Dim hProg As Long
Dim hProcess As Long
Dim ExitCode As Long

'fill in the missing parameter and execute the program
If IsMissing(WindowState) Then WindowState = 1
hProg = Shell(PathName, WindowState)
'hProg is a "process ID under Win32. To get the process handle:
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg)

Do
'populate Exitcode variable
GetExitCodeProcess hProcess, ExitCode
DoEvents
Loop While ExitCode = STILL_ACTIVE


End Sub

Sub ShellAndWait2(PathName As String)
'this version allows for blind FTP of small files
'Really brief FTPs will crash the shell without a wait
Dim hProg As Long
Dim hProcess As Long
Dim ExitCode As Long

hProg = Shell(PathName, 0)
'hProg is a "process ID under Win32. To get the process handle:
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, hProg)

Application.Wait (Now + TimeValue("0:00:01"))

Do
'populate Exitcode variable
GetExitCodeProcess hProcess, ExitCode
DoEvents
Loop While ExitCode = STILL_ACTIVE


End Sub

Sub PartialFTP(InputFN As String, OutputFN As String)
'PartialFTP uses Windows API calls to: run a Shell command, force
'Excel to wait a specified time, then to kill the running FTP
'process, and then to wait for the shell window to close before
'continuing to execute the VBA script.
'InputFN = full name of Batch file that invokes an FTP download
'OutputFN = full name of file being FTPed


'Start running shell routine
Shell InputFN, 0

'wait until output file exists before proceeding
'(ie, wait for FTP transfer to begin)
Do Until Dir(OutputFN) <> Empty
'wait in intervals of about a quarter second
Application.Wait Now + 0.000003
Loop
'Let the FTP transfer run for 2 full seconds
Application.Wait Now + TimeValue("00:00:02")
'Kill the FTP process.
'(this returns control to the batch file, which then continues.)
Kill_ProcByName ("FTP.exe (ftp://ftp.exe)")


End Sub

Sub Kill_ProcByName(NameOfExe As String)

Dim oProcList As Object
Dim oWMI As Object
Dim oProc As Object

' step 1: create WMI object instance:
Set oWMI = GetObject("winmgmts:")
If IsNull(oWMI) = False Then
' step 2: create object collection of Win32 processes:
Set oProcList = oWMI.InstancesOf("win32_process")
' step 3: iterate through the enumerated collection:
For Each oProc In oProcList
' option to close a process:
If UCase(oProc.Name) = UCase(NameOfExe) Then
On Error Resume Next
oProc.Terminate (0)
On Error GoTo 0
End If 'IsNullUCase(oProc.Name) = UCase(NameOfExe)
Next 'oProc In oProcList
End If 'IsNull(oWMI) = False
' step 4: clear out the objects:
Set oProcList = Nothing
Set oWMI = Nothing


End Sub


Here are generalized functions for DLing and checking the DIR. I usually make custom versions of the functions for specific things like CDing through a directory structure on the FTP site.

Function FTPDownload(URL As String, LoginID As String, LoginPW As String, _
FileToGet As String, Optional OutputPath As String) As Boolean

Dim strTempDL As String
Dim strOutput As String
Dim oFS As Object
Dim oTS As Object

FTPDownload = False

'check for temp directory, create it if neccesary
strTempDL = Environ("TEMP") & "\FTPTemp"
If Dir(strTempDL, vbDirectory) = Empty Then MkDir (strTempDL)

'if target file exists, delete it.
If Not Dir(strTempDL & "\" & FileToGet) = Empty Then
Kill strTempDL & "\" & FileToGet

'if the file is still there, raise error
If Not Dir(strTempDL & "\" & FileToGet) = Empty Then Exit Function
End If
'invoke File System Object
Set oFS = CreateObject("Scripting.FileSystemObject")

'Build new FTP batch file (over-writes the old one):
Set oTS = oFS.CreateTextFile(strTempDL & "\FTP.bat", True)
With oTS
.writeline "@echo off"
.writeline "echo."
.writeline "Echo Contacting FTP server"
.writeline "echo."
.writeline "ftp -v -s:" & strTempDL & "\FTP.dat"
.writeline "echo."
.writeline "echo ALL DONE!"
.writeline "echo."
.writeline "exit"
.Close
End With
'Build new FTP .DAT file (over-writes the old one):
Set oTS = oFS.CreateTextFile(strTempDL & "\FTP.dat", True)
With oTS
.writeline "open " & URL
.writeline LoginID
.writeline LoginPW
.writeline "verbose"
.writeline "binary"
.writeline "get " & FileToGet & " " & Chr(34) & strTempDL _
& "\" & FileToGet & Chr(34)
.writeline "quit"
.Close
End With

Set oTS = Nothing


'**run FTP BAT through Shell and wait
ShellAndWait strTempDL & "\FTP.bat"
Application.Windows(1).Activate

'If file was sucessfully DLed, copy it over
If FileLen(strTempDL & "\" & FileToGet) = 0 Then

On Error Resume Next
Kill strTempDL & "\" & FileToGet
On Error GoTo 0

FTPDownload = False

Else

'get final path for output file
If OutputPath = Empty Then
'if none was specified, use the desktop
strOutput = Environ("USERPROFILE") _
& "\Desktop\" & FileToGet
Else
If Right(OutputPath, 1) = "\" Then
strOutput = OutputPath & FileToGet
Else
strOutput = OutputPath & "\" & FileToGet
End If
End If

'delete output file (incase its there)
On Error Resume Next
Kill (strOutput)
On Error GoTo 0

oFS.CopyFile strTempDL & "\" & FileToGet, strOutput

FTPDownload = True

End If

'delete temp FTP files
On Error Resume Next
Kill (strTempDL & "\FTP.bat")
Kill (strTempDL & "\FTP.dat")
Kill (strTempDL & "\" & FileToGet)
On Error GoTo 0

Set oFS = Nothing


End Function

Function FTPDir(URL As String, LoginID As String, LoginPW As String) As String

Dim strTempDL As String
Dim oFS As Object
Dim oTS As Object

Set oFS = CreateObject("Scripting.FileSystemObject")
'check for temp directory, create it if neccesary
strTempDL = Environ("TEMP") & "\FTPTemp"
If Dir(strTempDL, vbDirectory) = Empty Then MkDir (strTempDL)
'invoke File System Object
Set oFS = CreateObject("Scripting.FileSystemObject")
'Delete outputfile (if exists)
On Error Resume Next
Kill strTempDL & "\out.txt"
On Error GoTo 0
'Build new FTP batch file (over-writes the old one):
Set oTS = oFS.CreateTextFile(strTempDL & "\FFS.bat", True)
With oTS
.writeline "ftp -v -s:" & strTempDL & "\FFS.dat > " & strTempDL & "\out.txt"
.writeline "exit"
.Close
End With

'Build new FTP .DAT file (over-writes the old one):
Set oTS = oFS.CreateTextFile(strTempDL & "\FFS.dat", True)
With oTS
.writeline "open " & URL
.writeline LoginID
.writeline LoginPW
.writeline "dir"
.writeline "quit"
.Close
End With

'Run through shell and wait
ShellAndWait strTempDL & "\FFS.bat", 0


'read in output file
Set oTS = oFS.OpenTextFile(strTempDL & "\out.txt", 1)

FTPDir = oTS.readall

oTS.Close
Set oTS = Nothing
Set oFS = Nothing

'delete temp FTP files
On Error Resume Next
Kill (strTempDL & "\FTP.bat")
Kill (strTempDL & "\FTP.dat")
Kill (strTempDL & "\out.txt")
On Error GoTo 0

End Function


Use these functions like this:

Private Sub TestFTPDownload()
Application.StatusBar = "Downloading file from FTP site..."

If FTPDownload("URL", "ID", "Password", "monbmk.txt") = False Then
MsgBox "File download unsucessful.", vbCritical, "Error!"
Else
MsgBox "FTP File transfer sucessful.", vbOK, "Download complete"
End If

Application.StatusBar = False
End Sub

Private Sub TestFTPDIR()
Dim strDIR As String

Application.StatusBar = "Checking the FTP DIR..."
strDIR = FTPDir("URL", "ID", "Password")

If strDIR = Empty Then
MsgBox "Could not get DIR information.", vbCritical, "Error!"
Else
MsgBox strDIR, vbOK, "DIR contents:"
End If

Application.StatusBar = False

End Sub



If you want to find information about specific files, you'll need to do some text string parsing with InStr() and Mid().

Hope this helps.

Kenneth Hobs
04-03-2009, 09:15 AM
Thanks for the code Dr.K. You could look through the KB entries and if one is not there then post it. It takes a long time to get them reviewed so be patient.

Here is the code that I use to wait for shelled process to finish. The last part shows an example using it. I just put all this in a module and use it in others.

'http://support.microsoft.com/kb/q129796/
Private Type STARTUPINFO
cb As Long
lpReserved As String
lpDesktop As String
lpTitle As String
dwX As Long
dwY As Long
dwXSize As Long
dwYSize As Long
dwXCountChars As Long
dwYCountChars As Long
dwFillAttribute As Long
dwFlags As Long
wShowWindow As Integer
cbReserved2 As Integer
lpReserved2 As Long
hStdInput As Long
hStdOutput As Long
hStdError As Long
End Type

Private Type PROCESS_INFORMATION
hProcess As Long
hThread As Long
dwProcessId As Long
dwThreadId As Long
End Type

'Enum enSW
' SW_Hide = 0
' SW_NORMAL = 1
' SW_MAXIMIZE = 3
' SW_MINIMIZE = 6
'End Enum
'Enum enPriority_Class
' NORMAL_PRIORITY_CLASS = &H20
' IDLE_PRIORITY_CLASS = &H40
' HIGH_PRIORITY_CLASS = &H80
'End Enum

Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
hHandle As Long, ByVal dwMilliseconds As Long) As Long

Private Declare Function CreateProcessA Lib "kernel32" (ByVal _
lpApplicationName As String, ByVal lpCommandLine As String, ByVal _
lpProcessAttributes As Long, ByVal lpThreadAttributes As Long, _
ByVal bInheritHandles As Long, ByVal dwCreationFlags As Long, _
ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As String, _
lpStartupInfo As STARTUPINFO, lpProcessInformation As _
PROCESS_INFORMATION) As Long

Private Declare Function CloseHandle Lib "kernel32" _
(ByVal hObject As Long) As Long

Private Declare Function GetExitCodeProcess Lib "kernel32" _
(ByVal hProcess As Long, lpExitCode As Long) As Long

Private Const INFINITE = -1&
Private Const STARTF_USESHOWWINDOW = &H1


Public Function ExecCmd(cmdLine$, Optional windowstyle As Integer = 0, _
Optional priorityclass As Integer = &H20)
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
Dim ret As Long

' Initialize the STARTUPINFO structure:
start.cb = Len(start)
start.dwFlags = STARTF_USESHOWWINDOW
start.wShowWindow = windowstyle

' Start the shelled application:
ret& = CreateProcessA(vbNullString, cmdLine$, 0&, 0&, 0&, _
priorityclass, 0&, vbNullString, start, proc)

' Wait for the shelled application to finish:
ret& = WaitForSingleObject(proc.hProcess, INFINITE)
Call GetExitCodeProcess(proc.hProcess, ret&)
Call CloseHandle(proc.hThread)
Call CloseHandle(proc.hProcess)
ExecCmd = ret&
End Function

Sub Form_Click()
Dim retval As Long
retval = ExecCmd("notepad.exe")
MsgBox "Process Finished, Exit Code " & retval
End Sub

londoner
04-04-2009, 02:30 PM
Sub Test_DownloadFile1()
MsgBox DownloadFile("ftp://ftp.simtel.net", _
"/pub/simtelnet/msdos/info/ftp-list.zip", _
"C:\Temp\ftp-list.zip")
'Username is anonymous or ftp.
'Password is your email address for courtesy.
Shell "cmd /c C:\Temp\ftp-list.zip", vbNormalFocus
End Sub

'Requires Reference: MSINET.OCX in Microsoft Internet Transfer Control
Function DownloadFile1(ByVal HostName As String, _
ByVal RemoteFileName As String, _
ByVal LocalFileName As String, _
Optional ByVal UserName As String = "anonymous", _
Optional ByVal Password As String = "khobson@aaaahawk.com", _
Optional ByVal ProxyServer As String = "") As String

Dim vtData As Variant
Load UserForm1
With UserForm1.Inet1
'.AccessType = icNamedProxy
.Proxy = ProxyServer
.URL = HostName
.Protocol = icFTP '2
.UserName = UserName
.Password = Password
.Execute , "Get " + RemoteFileName + " " + LocalFileName
Do While .StillExecuting
DoEvents
Loop

DownloadFile1 = .ResponseInfo
.Execute , "Close"
End With

Unload UserForm1
End Function



I'm trying to persevere with this code but I get the following error using the same FTP details as above:

Kenneth Hobs
04-04-2009, 03:41 PM
You called Download but only Download1 exists. Change one or the other.

It worked fine for me. It works better than the DOS method for me. It it doesn't work for you, I suspect even ftp by DOS would not work.

To try the ftp by DOS method, do it manually to test initially. Connecting to Simtel fails sometimes if there are too many users logged on. Doing it via DOS, it hung on the Password entry.
e.g
Start > Run > cmd
ftp ftp.simtel.net
anonymous
krhobson@aaahawk.com
cd pub/simtelnet/msdos/info
binary
get ftp-list.zip c:/temp/ftp-list.zip
bye

If I get time and remember, I will try another anonymous ftp site to test.