vba上传文件到ftp服务器指定目录 +脚本形式
文章目录
- 1. 测试版本无校验：
- 2. 测试版本有检验
- 3. 文件不存在校验版本
- 4. 文件不存在校验+必填项校验版本
1. 测试版本无校验：
Sub 按钮1_Click()
Dim i, str1, str2, str3, str4, str5, str6, str7, str8, str9, str10, d
Dim myarray()
On Error Resume Next
Set mysheet1 = ThisWorkbook.Worksheets("sheetName自定义")
Set fs = CreateObject("Scripting.FileSystemObject")'获取本地路径
If mysheet1.Cells(2, 3) <> "" Then
str3 = Replace(Sheet1.Cells(2, 3), "/", "\")
str3 = Trim(str3)
If Right(str3, 1) <> "\" Then
str3 = str3 & "\"
'MsgBox str6
End If
End If'循环扫描文件名,生成一个只有文件名字的字符串
For i = 4 To 100
If mysheet1.Cells(i, 3) <> "" Then
str1 = Replace(Sheet1.Cells(i, 3), "/", "\")
str1 = Trim(str1)
str4 = str3 & str1
str5 = "Echo mput " & Chr(34) & str4 & Chr(34) & " >>ftp.up"
str9 = str9 & " " & str5 'str9所有要上传的文件
End If
Next
'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.Close
str16 = "cmd.exe /c " & str10 '运行脚本
'MsgBox str16
Shell str16MsgBox "传输完成"
End Sub
2. 测试版本有检验
Sub 文件上传ftp服务器()
Dim i, str1, str2, str3, str4, str5, str6, str7, str8, str9, str10, d
Dim myarray(), MyFile As Object
Set MyFile = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set mysheet1 = ThisWorkbook.Worksheets("sheetName自定义")
Set fs = CreateObject("Scripting.FileSystemObject")'获取本地路径
If mysheet1.Cells(2, 3) <> "" Then
str3 = Replace(Sheet1.Cells(2, 3), "/", "\")
str3 = Trim(str3)
If Right(str3, 1) <> "\" Then
str3 = str3 & "\"
'MsgBox str6
End If
End If'循环扫描文件名,生成一个只有文件名字的字符串
For i = 4 To 100
If mysheet1.Cells(i, 3) <> "" Then
str1 = Replace(Sheet1.Cells(i, 3), "/", "\")
str1 = Trim(str1)
str4 = str3 & str1If MyFile.FileExists(str4) = True Then
Else
MsgBox str4 & " 文件不存在"
End Ifstr5 = "Echo mput " & Chr(34) & str4 & Chr(34) & " >>ftp.up"
str9 = str9 & " " & str5 'str9所有要上传的文件
End If
Next
'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.Close
str16 = "cmd.exe /c " & str10 '运行脚本
'MsgBox str16
Shell str16MsgBox "传输完成"
End Sub
3. 文件不存在校验版本
Sub 代码文件上传()Dim i, str1, str2, str3, str4, str5, str6, str7, str8, str9, str10, d
Dim myarray(), MyFile As Object
Set MyFile = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set mysheet1 = ThisWorkbook.Worksheets("核心_变更解决方案（模版）")
Set fs = CreateObject("Scripting.FileSystemObject")'获取本地路径
If mysheet1.Cells(18, 5) <> "" Then
str3 = Replace(Sheet1.Cells(18, 5), "/", "\")
str3 = Trim(str3)
If Right(str3, 1) <> "\" Then
str3 = str3 & "\"
'MsgBox str6
End If
End If'循环扫描文件名,生成一个只有文件名字的字符串
For i = 20 To 100
If mysheet1.Cells(i, 5) <> "" Then
str1 = Replace(Sheet1.Cells(i, 5), "/", "\")
str1 = Trim(str1)
str4 = str3 & str1If MyFile.FileExists(str4) = True Then
Else
MsgBox str4 & " 文件不存在"
End Ifstr5 = "Echo mput " & Chr(34) & str4 & Chr(34) & " >>ftp.up"
str9 = str9 & " " & str5 'str9所有要上传的文件
End If
Next
'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.Close
str16 = "cmd.exe /c " & str10 '运行脚本
'MsgBox str16
Shell str16MsgBox "传输完成"
End Sub4. 文件不存在校验+必填项校验版本
Sub 代码文件上传()' 定义变量 i for循环, str1 文件路径, str3本地路径, str4=str3+str1 文件的绝对路径, str5 批量上传文件列表
'str9 所有要上传的文件, str10=str3+1.bat
Dim 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) = "" Then
MsgBox "系统名称不能为空"
MsgBox "请填写信息完成后，请重新上传！"
Exit Sub
End If
If mysheet1.Cells(3, 2) = "" Then
MsgBox "模块名称不能为空"
MsgBox "请填写信息完成后，请重新上传！"
Exit Sub
End If
If mysheet1.Cells(3, 3) = "" Then
MsgBox "用户名不能为空"
MsgBox "请填写信息完成后，请重新上传！"
Exit Sub
End If
If mysheet1.Cells(3, 4) = "" Then
MsgBox "口令不能为空"
MsgBox "请填写信息完成后，请重新上传！"
Exit Sub
End If
If mysheet1.Cells(5, 1) = "" Then
MsgBox "变更号不能为空"
MsgBox "请填写信息完成后，请重新上传！"
Exit Sub
End If
' ----判断指定必填项是否为空 End----'获取本地路径
If mysheet1.Cells(3, 5) <> "" Then
str3 = Replace(Sheet1.Cells(3, 5), "/", "\")
str3 = Trim(str3)
If Right(str3, 1) <> "\" Then
str3 = str3 & "\"End If
Else: MsgBox "本地路径不能为空"
MsgBox "请填写信息完成后，请重新上传！"
Exit Sub
End If'获取指定表格值
strname = mysheet1.Cells(3, 2)For c = 1 To 25
initkey = checklist.Cells(c, 3)
If initkey = strname Then
strname1 = checklist.Cells(c, 4)
Exit For
End If
Nextloginname = mysheet1.Cells(3, 3)
If strname1 <> loginname Then
MsgBox "模块名与用户名不区配，请核实！！！"
MsgBox "请填写信息完成后，请重新上传！"
Exit Sub
End If'循环扫描文件名,生成一个只有文件名字的字符串
For i = 5 To 100
If mysheet1.Cells(i, 5) <> "" Then
str1 = Replace(Sheet1.Cells(i, 5), "/", "\")
str1 = Trim(str1)
str4 = str3 & str1If MyFile.FileExists(str4) = True Then
Else
MsgBox str4 & " 文件不存在"
End Ifstr5 = "Echo mput " & Chr(34) & str4 & Chr(34) & " >>ftp.up"
str9 = str9 & " " & str5 'str9所有要上传的文件
End If
Next
'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 str16
Shell str16MsgBox "传输完成"
End Sub1.bat脚本
@Echo Off
set "i=/app/CodeQualityScan/系统名/用户名/
set filesname=变更号
Echo open IP地址>ftp.up
Echo 用户名>>ftp.up
Echo 口令>>ftp.up
Echo Cd .\User >>ftp.up
Echo binary>>ftp.up
Echo cd %i%>>ftp.up
Echo mkdir %filesname%>>ftp.up
Echo cd %filesname%>>ftp.up
Echo prompt >>ftp.up
Echo 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.up
Echo bye>>ftp.up
FTP -s:ftp.up
del ftp.up /q
