|
|
楼主 |
发表于 2023-4-15 13:58:29
|
显示全部楼层
回复 5# 77七
终于成功解决,感谢- Dim fso,msg,tt,ws,d,str
- Set ws = WScript.CreateObject("WScript.shell")
- Set fso = CreateObject("Scripting.FileSystemObject")
- d = Format_Time(Now(),6)
- Function Format_Time(s_Time, n_Flag)
- Dim y, m, d, h, mi, s
- Format_Time = ""
- If IsDate(s_Time) = False Then Exit Function
- y = cstr(year(s_Time))
- m = cstr(month(s_Time))
- If len(m) = 1 Then m = "0" & m
- d = cstr(day(s_Time))
- If len(d) = 1 Then d = "0" & d
- h = cstr(hour(s_Time))
- If len(h) = 1 Then h = "0" & h
- mi = cstr(minute(s_Time))
- If len(mi) = 1 Then mi = "0" & mi
- s = cstr(second(s_Time))
- If len(s) = 1 Then s = "0" & s
- Select Case n_Flag
- Case 1
- ' yyyy-mm-dd hh:mm:ss
- Format_Time = y & "-" & m & "-" & d & " "& h &":" & mi &":" & s
- Case 2
- ' yyyy-mm-dd
- Format_Time = y & "-" & m & "-" & d
- Case 3
- ' hh:mm:ss
- Format_Time = h & ":" & mi & ":" & s
- Case 4
- ' yyyy年mm月dd日
- Format_Time = y & "年" & m & "月" & d & "日"
- Case 5
- ' yyyymmdd
- Format_Time = y & m & d
- Case 6
- ' yyyy-mm-dd-hh-mm-ss
- Format_Time = y & m & d & "-"& h & mi & s
- End Select
- End Function
- str = inputbox("输入文件夹名称")
- Set objShell = CreateObject("Shell.Application")
- Set objWindows = objShell.Windows
- strFolder = ""
- For i = objWindows.Count - 1 To 0 Step -1
- ' Check if the window belongs to Windows Explorer
- If InStr(1, objWindows.Item(i).FullName, "explorer.exe", vbTextCompare) > 0 Then
- ' Get the location of the last opened window
- strFolder = objWindows.Item(i).Document.Folder.Self.Path
- 'set fn = objWindows.Item(i).Document.Folder
- if ws.appactivate(objWindows.Item(i).Document.Folder) =true then
- Exit For
- end if
- End If
- Next
- ' Output the directory path of the last opened window
- 'WScript.Echo strFolder
- m = "-" & str
- 'tt1 = fso.FolderExists(fldr1) '存在返回true;不存在返回false
- 'tt2 = fso.FolderExists(fldr2) '存在返回true;不存在返回false
- 'If str = false Then
- If left(strFolder,7)<> "\\share" Then
- Fldr1 = d & str
- Fldr2 = d & m
- If isempty(str) or str = "" Then
- fso.CreateFolder Fldr1
- Else
- fso.CreateFolder Fldr2
- 'ws.run Fldr2
- End If
- Else
- Fldr3 = strFolder & "" & d & str
- Fldr4 = strFolder & "" & d & m
- If isempty(str) or str = "" Then
- fso.CreateFolder Fldr3
- Else
- fso.CreateFolder Fldr4
- End If
- End If
- Set fso = nothing
- Set ws = nothing
复制代码 |
|