vba上传文件到ftp服务器指定目录 +脚本形式
文章目录
1. 测试版本无校验：2. 测试版本有检验3. 文件不存在校验版本4. 文件不存在校验+必填项校验版本1. 测试版本无校验：
Sub 按钮1_Click()Dim i, str1, str2, str3, str4, str5, str6, str7, str8, str9, str10, dDim myarray()On Error Resume NextSet mysheet1 = ThisWorkbook.Worksheets("sheetName自定义")Set fs = CreateObject("Scripting.FileSystemObject")'获取本地路径If mysheet1.Cells(2, 3) <> "" Thenstr3 = Replace(Sheet1.Cells(2, 3), "/", "\")str3 = Trim(str3)If Right(str3, 1) <> "\" Thenstr3 = str3 & "\"'MsgBox str6End IfEnd If'循环扫描文件名,生成一个只有文件名字的字符串For i = 4 To 100If mysheet1.Cells(i, 3) <> "" Thenstr1 = Replace(Sheet1.Cells(i, 3), "/", "\")str1 = Trim(str1)str4 = str3 & str1str5 = "Echo mput " & Chr(34) & str4 & Chr(34) & " >>ftp.up"str9 = str9 & " " & str5 'str9所有要上传的文件End IfNext'MsgBox str9'上传Set fsd = CreateObject("Scripting.FileSystemObject")str10 = str3 & "1.bat" '脚本str11 = "Echo open ip地址>ftp.up" '远程路径str12 = "Echo 用户名>>ftp.up" '账号str13 = "Echo 密码>>ftp.up" '密码Set fid = fsd.CreateTextFile(str10, True) '后面开始写脚本fid.WriteLine ("@Echo Off ") '开远程fid.WriteLine (str11)fid.WriteLine (str12)fid.WriteLine (str13)fid.WriteLine ("Echo Cd .\User >>ftp.up")fid.WriteLine ("Echo binary>>ftp.up")fid.WriteLine ("Echo prompt >>ftp.up")fid.WriteLine ("Echo lcd " & Chr(34) & str3 & Chr(34) & ">>ftp.up")fid.WriteLine (str9)fid.WriteLine ("Echo bye>>ftp.up")fid.WriteLine ("FTP -s:ftp.up")fid.WriteLine ("del ftp.up /q")fid.Closestr16 = "cmd.exe /c " & str10 '运行脚本'MsgBox str16Shell str16MsgBox "传输完成"End Sub
2. 测试版本有检验
Sub 文件上传ftp服务器()Dim i, str1, str2, str3, str4, str5, str6, str7, str8, str9, str10, dDim myarray(), MyFile As ObjectSet MyFile = CreateObject("Scripting.FileSystemObject")On Error Resume NextSet mysheet1 = ThisWorkbook.Worksheets("sheetName自定义")Set fs = CreateObject("Scripting.FileSystemObject")'获取本地路径If mysheet1.Cells(2, 3) <> "" Thenstr3 = Replace(Sheet1.Cells(2, 3), "/", "\")str3 = Trim(str3)If Right(str3, 1) <> "\" Thenstr3 = str3 & "\"'MsgBox str6End IfEnd If'循环扫描文件名,生成一个只有文件名字的字符串For i = 4 To 100If mysheet1.Cells(i, 3) <> "" Thenstr1 = Replace(Sheet1.Cells(i, 3), "/", "\")str1 = Trim(str1)str4 = str3 & str1If MyFile.FileExists(str4) = True ThenElseMsgBox str4 & " 文件不存在"End Ifstr5 = "Echo mput " & Chr(34) & str4 & Chr(34) & " >>ftp.up"str9 = str9 & " " & str5 'str9所有要上传的文件End IfNext'MsgBox str9'上传Set fsd = CreateObject("Scripting.FileSystemObject")str10 = str3 & "1.bat" '脚本str11 = "Echo open IP地址>ftp.up" '远程路径str12 = "Echo 用户名>>ftp.up" '账号str13 = "Echo 口令>>ftp.up" '密码Set fid = fsd.CreateTextFile(str10, True) '后面开始写脚本fid.WriteLine ("@Echo Off ") '开远程fid.WriteLine (str11)fid.WriteLine (str12)fid.WriteLine (str13)fid.WriteLine ("Echo Cd .\User >>ftp.up")fid.WriteLine ("Echo binary>>ftp.up")fid.WriteLine ("Echo prompt >>ftp.up")fid.WriteLine ("Echo lcd " & Chr(34) & str3 & Chr(34) & ">>ftp.up")fid.WriteLine (str9)fid.WriteLine ("Echo bye>>ftp.up")fid.WriteLine ("FTP -s:ftp.up")fid.WriteLine ("del ftp.up /q")fid.Closestr16 = "cmd.exe /c " & str10 '运行脚本'MsgBox str16Shell str16MsgBox "传输完成"End Sub
3. 文件不存在校验版本
Sub 代码文件上传()Dim i, str1, str2, str3, str4, str5, str6, str7, str8, str9, str10, dDim myarray(), MyFile As ObjectSet MyFile = CreateObject("Scripting.FileSystemObject")On Error Resume NextSet mysheet1 = ThisWorkbook.Worksheets("核心_变更解决方案（模版）")Set fs = CreateObject("Scripting.FileSystemObject")'获取本地路径If mysheet1.Cells(18, 5) <> "" Thenstr3 = Replace(Sheet1.Cells(18, 5), "/", "\")str3 = Trim(str3)If Right(str3, 1) <> "\" Thenstr3 = str3 & "\"'MsgBox str6End IfEnd If'循环扫描文件名,生成一个只有文件名字的字符串For i = 20 To 100If mysheet1.Cells(i, 5) <> "" Thenstr1 = Replace(Sheet1.Cells(i, 5), "/", "\")str1 = Trim(str1)str4 = str3 & str1If MyFile.FileExists(str4) = True ThenElseMsgBox str4 & " 文件不存在"End Ifstr5 = "Echo mput " & Chr(34) & str4 & Chr(34) & " >>ftp.up"str9 = str9 & " " & str5 'str9所有要上传的文件End IfNext'MsgBox str9'上传Set fsd = CreateObject("Scripting.FileSystemObject")str10 = str3 & "1.bat" '脚本str11 = "Echo open IP地址>ftp.up" '远程路径str12 = "Echo 用户名>>ftp.up" '账号str13 = "Echo 口令>>ftp.up" '密码Set fid = fsd.CreateTextFile(str10, True) '后面开始写脚本fid.WriteLine ("@Echo Off ") '开远程fid.WriteLine (str11)fid.WriteLine (str12)fid.WriteLine (str13)fid.WriteLine ("Echo Cd .\User >>ftp.up")fid.WriteLine ("Echo binary>>ftp.up")fid.WriteLine ("Echo prompt >>ftp.up")fid.WriteLine ("Echo lcd " & Chr(34) & str3 & Chr(34) & ">>ftp.up")fid.WriteLine (str9)fid.WriteLine ("Echo bye>>ftp.up")fid.WriteLine ("FTP -s:ftp.up")fid.WriteLine ("del ftp.up /q")fid.Closestr16 = "cmd.exe /c " & str10 '运行脚本'MsgBox str16Shell str16MsgBox "传输完成"End Sub
4. 文件不存在校验+必填项校验版本
Sub 代码文件上传()' 定义变量 i for循环, str1 文件路径, str3本地路径, str4=str3+str1 文件的绝对路径, str5 批量上传文件列表'str9 所有要上传的文件, str10=str3+1.batDim i, str1, str3, str4, str5, str9, str10'strname1 key对应的value 这里指系统名, strname 获取模块名称, loginname 登录用户, loginpwd 登录口令Dim myarray(), MyFile As Object, strname1, strname, loginname, loginpwd'创建了一个FSO对象，然后中用它来读写文本文件，删除文件等Set MyFile = CreateObject("Scripting.FileSystemObject")'当加上On Error Resume Next语句后，如果后面的程序出现"运行时错误"时，会继续运行，不中断。On Error Resume Next'定义(变更文件扫描清单)工作表Set mysheet1 = ThisWorkbook.Worksheets("变更文件扫描清单")'定义(Sheet1)工作表Set checklist = ThisWorkbook.Worksheets("Sheet1")'创建了一个FSO对象，然后中用它来读写文本文件，删除文件等Set fs = CreateObject("Scripting.FileSystemObject")' ----判断指定必填项是否为空 Start----If mysheet1.Cells(3, 1) = "" ThenMsgBox "系统名称不能为空"MsgBox "请填写信息完成后，请重新上传！"Exit SubEnd IfIf mysheet1.Cells(3, 2) = "" ThenMsgBox "模块名称不能为空"MsgBox "请填写信息完成后，请重新上传！"Exit SubEnd IfIf mysheet1.Cells(3, 3) = "" ThenMsgBox "用户名不能为空"MsgBox "请填写信息完成后，请重新上传！"Exit SubEnd IfIf mysheet1.Cells(3, 4) = "" ThenMsgBox "口令不能为空"MsgBox "请填写信息完成后，请重新上传！"Exit SubEnd IfIf mysheet1.Cells(5, 1) = "" ThenMsgBox "变更号不能为空"MsgBox "请填写信息完成后，请重新上传！"Exit SubEnd If' ----判断指定必填项是否为空 End----'获取本地路径If mysheet1.Cells(3, 5) <> "" Thenstr3 = Replace(Sheet1.Cells(3, 5), "/", "\")str3 = Trim(str3)If Right(str3, 1) <> "\" Thenstr3 = str3 & "\"End IfElse: MsgBox "本地路径不能为空"MsgBox "请填写信息完成后，请重新上传！"Exit SubEnd If'获取指定表格值strname = mysheet1.Cells(3, 2)For c = 1 To 25initkey = checklist.Cells(c, 3)If initkey = strname Thenstrname1 = checklist.Cells(c, 4)Exit ForEnd IfNextloginname = mysheet1.Cells(3, 3)If strname1 <> loginname ThenMsgBox "模块名与用户名不区配，请核实！！！"MsgBox "请填写信息完成后，请重新上传！"Exit SubEnd If'循环扫描文件名,生成一个只有文件名字的字符串For i = 5 To 100If mysheet1.Cells(i, 5) <> "" Thenstr1 = Replace(Sheet1.Cells(i, 5), "/", "\")str1 = Trim(str1)str4 = str3 & str1If MyFile.FileExists(str4) = True ThenElseMsgBox str4 & " 文件不存在"End Ifstr5 = "Echo mput " & Chr(34) & str4 & Chr(34) & " >>ftp.up"str9 = str9 & " " & str5 'str9所有要上传的文件End IfNext'MsgBox str9loginpwd = mysheet1.Cells(3, 4)'上传Set fsd = CreateObject("Scripting.FileSystemObject")str10 = str3 & "1.bat" '脚本str11 = "Echo open IP地址>ftp.up" '远程路径str12 = "Echo " & loginname & ">>ftp.up" '账号str13 = "Echo " & loginpwd & ">>ftp.up" '密码wj1 = "set " & Chr(34) & "i=/app/CodeQualityScan/" & loginname & "/" & loginname & "/"wj2 = "set filesname=" & mysheet1.Cells(5, 1)'---后面开始拼接脚本 Start---Set fid = fsd.CreateTextFile(str10, True)'开远程fid.WriteLine ("@Echo Off ")fid.WriteLine (wj1)fid.WriteLine (wj2)fid.WriteLine (str11)fid.WriteLine (str12)fid.WriteLine (str13)fid.WriteLine ("Echo Cd .\User >>ftp.up")fid.WriteLine ("Echo binary>>ftp.up")'进入指定ftp目录fid.WriteLine ("Echo cd %i%>>ftp.up")'创建指定文件夹fid.WriteLine ("Echo mkdir %filesname%>>ftp.up")'进入指定文件夹fid.WriteLine ("Echo cd %filesname%>>ftp.up")fid.WriteLine ("Echo prompt >>ftp.up")fid.WriteLine ("Echo lcd " & Chr(34) & str3 & Chr(34) & ">>ftp.up")fid.WriteLine (str9)fid.WriteLine ("Echo bye>>ftp.up")fid.WriteLine ("FTP -s:ftp.up")fid.WriteLine ("del ftp.up /q")fid.Close'---后面开始拼接脚本 End---str16 = "cmd.exe /c " & str10 '运行脚本'MsgBox str16Shell str16MsgBox "传输完成"End Sub
1.bat脚本
@Echo Off set "i=/app/CodeQualityScan/系统名/用户名/set filesname=变更号Echo open IP地址>ftp.upEcho 用户名>>ftp.upEcho 口令>>ftp.upEcho Cd .\User >>ftp.upEcho binary>>ftp.upEcho cd %i%>>ftp.upEcho mkdir %filesname%>>ftp.upEcho cd %filesname%>>ftp.upEcho prompt >>ftp.upEcho lcd "D:\Workspaces\xxxprojectname\">>ftp.upEcho mput "D:\Workspaces\xxxprojectname\ui\js\JsFileName.js" >>ftp.up Echo mput "D:\Workspaces\xxxprojectname\java\JavasadasasdsdsdFileName.java" >>ftp.up Echo mput "D:\Workspaces\xxxprojectname\ui\jsp\JspFileName.jsp" >>ftp.upEcho bye>>ftp.upFTP -s:ftp.updel ftp.up /q
