vba上傳指定檔案ftp伺服器

文章目錄

• ​​一、需求分析：​​
• ​​二、操作流程：​​

• ​​2.1 【開發工具】-【宏】​​
• ​​2.2 【宏】-【編輯】​​
• ​​2.3 【把腳本複制進去】​​
• ​​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 修改發ftp資訊​​
• ​​2.5.6 儲存腳本​​

• ​​三、添加上傳按鈕​​
• ​​效果圖：​​

一、需求分析：

• 在excel表格中指定檔案路徑，将指定檔案上傳ftp伺服器

二、操作流程：

2.1 【開發工具】-【宏】

2.2 【宏】-【編輯】

2.3 【把腳本複制進去】

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

'循環掃描檔案名,生成一個隻有檔案名字的字元串
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 str16

 MsgBox "傳輸完成"
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 修改發ftp資訊

• ip位址
• 使用者名
• 密碼

2.5.6 儲存腳本

三、添加上傳按鈕

• 【開發工具】-【插入表單控件】



• -【指定宏】



• -【選擇指定的宏名】



• 【輕按兩下修改按鈕名稱】

效果圖：

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 & str1

If MyFile.FileExists(str4) = True Then
Else
MsgBox str4 & " 檔案不存在"
End If

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 str16

 MsgBox "傳輸完成"
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

'循環掃描檔案名,生成一個隻有檔案名字的字元串
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 str16

 MsgBox "傳輸完成"
End Sub