VBA实现FTP上传文件的两种方式:①shell cmd命令②vba调用vb.net(传参并获取返回值)
本文想要上传文件夹内 特定文件名(Excel单元框内手动输入文件名)的文件。vb.net实现FTP文件的上传,代码简单,但vba需要调用所生成的exe文件 实现参数的传递并获取exe的返回值。但在用单纯的vba代码实现FTP文件上传的时候发现,。 如图⬇
vba需要①添加新的控件或者是②直接调用cmd命令,问题多多略显鸡肋。 ①添加新的控件→需要自行下载控件而放弃,未作尝试。 ②直接调用cmd命令→需要关闭ftp的防火墙,手动进入被动模式(literal pasv)。因环境而异尝试之后有点电脑可有的电脑则无法执行up语句。vba代码仅供参考:
Dim creatDate, fileName, FILE_DIR,localFileName As String Dim localFilePathName,batfile As String Dim FtpSevr,FtpUser,FtpPw,FtpPATH As String creatDate = Trim(Worksheets(strSheetNM).Cells(4, 3)) fileName = Trim(Worksheets(strSheetNM).Cells(5, 3)) FILE_DIR = "D:\ftpjp\" '本地文件路径 FtpSevr = "**********" 'Ftp名称 FtpUser = "**********" 'Ftp用户名 FtpPw = "**********" 'Ftp密码 FtpPATH = "**********" 'Ftp上存放uploa的文件夹名 '如果本地文件路径D:\ftpjp\中存在文件名含有fileName的xml类型的文件 If Dir(FILE_DIR & creatDate & "\" & "*" & fileName & "*.xml") <> "" Then '获取本地文件路径下的文件名,例file_100001.xml localFileName = Dir(FILE_DIR & creatDate & "\" & "*" & fileName & "*.xml") '本地文件路径+文件名,例D:\ftpjp\20200901\file_100001.xml localFilePathName = FILE_DIR & creatDate & "\" & localFileName '自动在Excel所在的路径下创建txt文件来存放要编写的cmd命令代码 batfile = ThisWorkbook.Path & "\ftpBatFile.txt" nFNO = FreeFile() '开始在创建txt文件里写入cmd命令代码 Open batfile For Output As #nFNO Print #nFNO, "open " & FtpSevr Print #nFNO, "user " & FtpUser & " " & FtpPwd Print #nFNO, "cd " & FtpPATH Print #nFNO, "binary" '二进制方式传输 Print #nFNO, "put " & localFilePathName Print #nFNO, "quit" Close #nFNO '执行cmd命令代码 Shell "ftp -n -s:" & batfile End Ifvb.net操作简单,但是想要传递文章开头部分讲的手入力的Data:20200901和文件名:100001的参数,并且获得vb.net内ftp是否上传成功的返回值。vba和vb.net代码仅供参考:
//vba代码 Dim creatDate, fileName, FILE_DIR,localFileName As String Dim WSH, wExec, sCmd As String, Result As String creatDate = Trim(Worksheets(strSheetNM).Cells(4, 3)) fileName = Trim(Worksheets(strSheetNM).Cells(5, 3)) 'vb.net编译生成的exe文件地址 exeFile = "D:\ftpjp\Upload.exe" Set WSH = CreateObject("WScript.Shell") '命令传递参数Exec("D:\ftpjp\Upload.exe {参数} {参数} /?") Set wExec = WSH.Exec(exeFile & creatDate & " " & strArchiveNo & " /?") '获取exe文件的返回值 Result = wExec.StdOut.ReadAll If Result = "1" Then MsgBox "upload成功" Else MsgBox "upload失败" End If Set wExec = Nothing Set WSH = Nothing //vb.net代码 Public Class Main '接收vba传递的参数arg() ,参数的个数对应arg(0), arg(1),...,arg(N) Shared Sub Main(ByVal arg() As String) Dim creatDate, fileName, FILE_DIR, localFileName As String Dim localPath, ftpFilePathFrom As String Dim FtpSevr, FtpUser, FtpPw, FtpPATH, strReturn As String Dim wc As New System.Net.WebClient() creatDate = arg(0) fileName = arg(1) FILE_DIR = "D:\ftpjp\" '本地文件路径 FtpSevr = "**********" 'Ftp名称 FtpUser = "**********" 'Ftp用户名 FtpPw = "**********" 'Ftp密码 FtpPATH = "**********" 'Ftp上存放uploa的文件夹名 strReturn = "" localPath = FILE_DIR & creatDate & "\" '路径D:\ftpjp\20200901\是否存在 If System.IO.Directory.Exists(localPath) = False Then Call WriteTraceLog("本地路径不存在") Else ftpFilePathFrom = "ftp://" & FtpSevr & FtpPATH wc.Credentials = New System.Net.NetworkCredential(FtpUser, FtpPw) wc.Proxy = Nothing '如果本地文件路径D:\ftpjp\中存在文件名含有fileName的xml类型的文件 If Dir(FILE_DIR & creatDate & "\" & "*" & fileName & "*.xml") <> "" Then localFileName = Dir(FILE_DIR & creatDate & "\" & "*" & fileName & "*.xml") wc.UploadFile(ftpFilePathFrom & localFileName, localPath & localFileName) 'Upload成功返回1 strReturn = strReturn & "1" Else 'Upload失败返回0 strReturn = strReturn & "0" End If '解放 wc.Dispose() End If '传递返回值 System.Console.WriteLine(strReturn) End Sub End Class