使用EXCEL VBA操作FTP服务器的技术汇总（附源代码）

xiamen168

FTP访问代码有三种实现方式，总结如下技术特征，请大家根据实际情况选择使用。

方法一代码最简洁，
方法二与系统结合度高，运行稳定，代码复杂，
方法三代码简单但需要第三方控件支持

方法一 使用SHELL启动ＦＴＰ命令

1. Sub 从FTP自动下载文件_SHELL()
   
2. Dim strPNAME As String '参数文件名
   
3. Dim nFNO As Integer '文件编号
   
4. 
   
5. strPNAME = ThisWorkbook.Path & "\ftptest.txt" '文件名生成
   
6. nFNO = FreeFile '获取空的文件号
   
7. 
   
8. Open strPNAME For Output As #nFNO '生成新的文件
   
9. 
   
10. Print #nFNO, "open plaza14.mbn.or.jp" 'open主机名
    
11. Print #nFNO, "user ken3 XXXXXX←路径" 'user命令 用户名 密码
    
12. Print #nFNO, "cd www"
    
13. Print #nFNO, "pwd"
    
14. Print #nFNO, "get index.html " & ThisWorkbook.Path & "\index.html"
    
15. 
    
16. Close #nFNO '关闭
    
17. 'shell启动ＦＴＰ -n为参数
    
18. Shell "ftp -n -s:" & strPNAME
    
19. 
    
20. End Sub
    
21. 
    
22. Sub 向FTP自动上传文件_SHELL()
    
23. Dim strFILENAME As String
    
24. 
    
25. strFILENAME = Application.GetOpenFilename
    
26. Call ftp_upfile("ftp.xxxx.jp", "username", "pass", "data/pc/", strFILENAME)
    
27. 
    
28. End Sub
    
29. 
    
30. Sub ftp_upfile(strHNAME As String, _
    
31. strUSERNAME As String, _
    
32. strPASS As String, _
    
33. strDIR As String, _
    
34. strUPFILE As String)
    
35. Dim strPNAME As String
    
36. Dim nFNO As Integer
    
37. 
    
38. strPNAME = ThisWorkbook.Path & "\ftppara.dat"
    
39. 
    
40. nFNO = FreeFile
    
41. Open strPNAME For Output As #nFNO
    
42. 
    
43. Print #nFNO, "open " & strHNAME
    
44. Print #nFNO, "user " & strUSERNAME & " " & strPASS
    
45. Print #nFNO, "cd " & strDIR 'cd xxxx 进入待写目录
    
46. Print #nFNO, "put " & strUPFILE 'put 上传文件
    
47. Print #nFNO, "quit" '退出
    
48. 
    
49. Close #nFNO
    
50. Shell "ftp -n -s:" & strPNAME
    
51. 
    
52. End Sub

复制代码

方法二 使用Win内置DLL进行FTP传输

1. Declare Function InternetOpen Lib "WinInet.DLL" Alias "InternetOpenA" (ByVal lpszAgent As String, ByVal dwAccessType As Long, ByVal lpszProxyName As String, ByVal lpszProxyBypass As String, ByVal dwFlags As Long) As Long
   
2. Declare Function InternetConnect Lib "WinInet.DLL" Alias "InternetConnectA" (ByVal hInternet As Long, ByVal lpszServerName As String, ByVal nServerPort As Integer, ByVal lpszUsername As String, ByVal lpszPassword As String, ByVal dwService As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
   
3. Declare Function FtpPutFile Lib "WinInet.DLL" Alias "FtpPutFileA" (ByVal hConnect As Long, ByVal lpszLocalFile As String, ByVal lpszNewRemoteFile As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean
   
4. Declare Function InternetCloseHandle Lib "WinInet.DLL" (ByVal hInternet As Long) As Integer
   
5. 
   
6. Const FTP_TRANSFER_TYPE_ASCII As Long = &H1 '文本模式
   
7. Const FTP_TRANSFER_TYPE_BINARY As Long = &H2 '2进制模式
   
8. 
   
9. Sub 从FTP自动下载文件_SHELL()
   
10. Dim server As String
    
11. Dim user As String
    
12. Dim passwd As String
    
13. Dim localFile As String
    
14. Dim serverFile As String
    
15. server = "ftp.server.jp" '主机名
    
16. user = "user" '用户名
    
17. passwd = "password" '密码
    
18. localFile = "C:\test.xls" '本地文件
    
19. serverFile = "/upload/zaiko/test.xls" 'FTP服务器端文件
    
20. 
    
21. Dim hOpen As Long
    
22. Dim hConnection As Long
    
23. Dim result As Long
    
24. Do
    
25. hOpen = InternetOpen(server, 1, vbNullString, vbNullString, 0)
    
26. If hOpen = 0 Then
    
27. MsgBox "Open错误：" & Err.LastDllError
    
28. Exit Do
    
29. End If
    
30. hConnection = InternetConnect(hOpen, server, 0, user, passwd, 1, 0, 0)
    
31. If hConnection = 0 Then
    
32. MsgBox "连接错误：" & Err.LastDllError
    
33. Exit Do
    
34. End If
    
35. If FtpPutFile(hConnection, localFile, serverFile, FTP_TRANSFER_TYPE_BINARY, 0) = 0 Then
    
36. MsgBox "传输错误：" & Err.LastDllError
    
37. Exit Do
    
38. End If
    
39. Loop Until True
    
40. If (hConnection <> 0) Then InternetCloseHandle hConnection
    
41. If (hOpen <> 0) Then InternetCloseHandle hOpen
    
42. MsgBox "成功鸟！"
    
43. End Sub

复制代码

方法三 使用basp21DLL进行FTP传输

1. Sub 从FTP自动上传文件_basp21()
   
2. Dim FTP, rc As Long, Server As String, User As String, Pass As String
   
3. Dim Target As String, Folder As String
   
4. Set FTP = CreateObject("basp21.FTP") ''FTP对象
   
5. Server = "ftp.xxxxx.com" ''主机地址
   
6. User = "toru_tanaka" ''用户名
   
7. Pass = "password" ''密码
   
8. Target = Application.GetOpenFilename() ''上传
   
9. If Target = "False" Then Exit Sub
   
10. Folder = "test/sub" ''上传文件夹
    
11. rc = FTP.Connect(Server, User, Pass)
    
12. If rc <> 0 Then
    
13. MsgBox "FTP无法连接", vbCritical
    
14. FTP.Close
    
15. Exit Sub
    
16. End If
    
17. rc = FTP.PutFile(Target, Folder)
    
18. If rc <> 1 Then
    
19. MsgBox Dir(Target) & "无法上传", vbCritical
    
20. FTP.Close
    
21. Exit Sub
    
22. End If
    
23. MsgBox Dir(Target) & "上传成功", vbInformation
    
24. FTP.Close
    
25. End Sub
    
26. 
    
27. Sub 从FTP自动下载文件_basp21()
    
28. Dim FTP, rc As Long, Server As String, User As String, Pass As String
    
29. Dim Target As String, Folder As String
    
30. Set FTP = CreateObject("basp21.FTP")
    
31. Server = "ftp.xxxxx.com"
    
32. User = "toru_tanaka"
    
33. Pass = "password"
    
34. Folder = ThisWorkbook.Path & "\data" ''本地文件夹
    
35. Target = "test/sub/sample.dat" ''下载文件名
    
36. rc = FTP.Connect(Server, User, Pass)
    
37. If rc <> 0 Then
    
38. MsgBox "FTP无法连接", vbCritical
    
39. FTP.Close
    
40. Exit Sub
    
41. End If
    
42. rc = FTP.GetFile(Target, Folder)
    
43. If rc <> 1 Then
    
44. MsgBox "文件无法下载", vbCritical
    
45. FTP.Close
    
46. Exit Sub
    
47. End If
    
48. MsgBox "文件下载成功", vbInformation
    
49. FTP.Close
    
50. End Sub

复制代码

该贴已经同步到 xiamen168的微博

fzkoko

挺好的资料

AVEL

感谢分享。 收藏备用了

lmswy

非常有用的东东！谢谢！

yaoihih

收藏了，谢谢。

aman1516

学习一下，收藏了。谢谢分享。

goldowl2011

Mark .Thanks a lot.Good info.

7176386

Ftp登陆提示连接超时这个有没有办法可以解决？

xiamen168

7176386 发表于 2014-10-23 10:17
Ftp登陆提示连接超时这个有没有办法可以解决？

需要调试排除环境问题

7176386

xiamen168 发表于 2015-1-9 10:23
需要调试排除环境问题

如果是使用VB6.0采用多线程的方式来处理Ftp访问超时的话，还是真心不好整，其一是Vb6多线程不稳定，调用Dll来处理的话，有时候也是会出现卡死的情况，我已经采用Asp动态网页+Access，这种稳定多了。。