用VB實現重新命名、拷貝資料夾及檔案

Private Sub commandButton1_Click()

'宣告資料夾名和路徑
Dim FileName, Path As String, EmptySheet As String
'Path = "D:\上報"
Path = InputBox("請輸入" & Chr(34) & "成績" & Chr(34) & "資料夾的路徑，格式如" & Chr(34) & "D:\成績" & Chr(34))
FileName = Path & "\上學期"
EmptySheet = Path & "\學期初始化"
'MsgBox FileName
If Dir(FileName, vbDirectory) <> "" Then
'MsgBox "資料夾存在"
'獲取系統當前時間
'Dim dd As Date
'dd = Now
'MsgBox Format(dd, "yyyymm")

Dim myTime As String
myTime = InputBox("請輸入當前時間，格式如" & Chr(34) & "201811" & Chr(34))
If myTime = "" Then
MsgBox "當前時間不能為空！否則不能重新命名當期資料夾"
Else:
Name FileName As Path & "\" & myTime
End If
End If
'判斷資料夾是否存在
If Dir(FileName, vbDirectory) = "" Then
'建立資料夾
MkDir (FileName)

'MsgBox ("建立完畢")
Else: MsgBox ("資料夾已在")
End If
'複製空表到當期
Set Fso = CreateObject("Scripting.FileSystemObject")
'拷貝資料夾
Fso.copyfolder EmptySheet, FileName
'Fso.copyfile EmptySheet&"c:\*.*", "d:\" '拷貝檔案
'FileSystemObject.copyfolder EmptySheet, FileName, 1
MsgBox ("操作成功！")
End Sub