文章目錄

• • 一、需求分析：
  • 二、操作流程：
  • • 2.1 【開發(fā)工具】-【宏】
    • 2.2 【宏】-【編輯】
    • 2.3 【把腳本復(fù)制進(jìn)去】
    • 2.4 腳本如下
    • 2.5 修改位置
    • • 2.5.1 修改sheet名稱和表格一致
      • 2.5.2 修改Cells(2,3)
      • 2.5.3 修改4 to 100
      • 2.5.4 修改Cells(i,3)
      • 2.5.5 修改發(fā)ftp信息
      • 2.5.6 保存腳本
  • 三、添加上傳按鈕
  • 效果圖：

一、需求分析：

• 在excel表格中指定文件路徑，將指定文件上傳ftp服務(wù)器

二、操作流程：

2.1 【開發(fā)工具】-【宏】

2.2 【宏】-【編輯】

2.3 【把腳本復(fù)制進(jìn)去】

2.4 腳本如下

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'循環(huán)掃描文件名,生成一個只有文件名字的字符串 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" '遠(yuǎn)程路徑 str12 = "Echo 用戶名>>ftp.up" '賬號 str13 = "Echo 密碼>>ftp.up" '密碼Set fid = fsd.CreateTextFile(str10, True) '后面開始寫腳本 fid.WriteLine ("@Echo Off ") '開遠(yuǎn)程 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.5 修改位置

2.5.1 修改sheet名稱和表格一致

2.5.2 修改Cells(2,3)

• 指的是地2行
  

2.5.3 修改4 to 100

• 4指的是從第4行的開始
• 100指的是從第100行開始
  

2.5.4 修改Cells(i,3)

• i指的是行，3指的是第幾列

2.5.5 修改發(fā)ftp信息

• ip地址
• 用戶名
• 密碼

2.5.6 保存腳本

三、添加上傳按鈕

• 【開發(fā)工具】-【插入表單控件】
  
  -【指定宏】
  
  -【選擇指定的宏名】
  
• 【雙擊修改按鈕名稱】

效果圖：

校驗版本

Sub 文件上傳ftp服務(wù)器() 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'循環(huán)掃描文件名,生成一個只有文件名字的字符串 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" '遠(yuǎn)程路徑 str12 = "Echo 用戶名>>ftp.up" '賬號 str13 = "Echo 密碼>>ftp.up" '密碼Set fid = fsd.CreateTextFile(str10, True) '后面開始寫腳本 fid.WriteLine ("@Echo Off ") '開遠(yuǎn)程 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

無校驗版本

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'循環(huán)掃描文件名,生成一個只有文件名字的字符串 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" '遠(yuǎn)程路徑 str12 = "Echo 用戶名>>ftp.up" '賬號 str13 = "Echo 密碼>>ftp.up" '密碼Set fid = fsd.CreateTextFile(str10, True) '后面開始寫腳本 fid.WriteLine ("@Echo Off ") '開遠(yuǎn)程 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

總結(jié)

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

如果覺得生活随笔網(wǎng)站內(nèi)容還不錯，歡迎將生活随笔推薦給好友。