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 Sub

4. 文件不存在校驗+必填項校驗版本

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 Sub

1.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

總結

以上是生活随笔為你收集整理的vba上传文件到ftp服务器指定目录下面的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。