[问题求助] 【已解决】请问VBS如何获取正在使用的文件夹路径呢？---已解决，感谢版主和网友帮助

wind5win

请问如何获取正在会使用的文件夹路径呢，不是获取脚本所在文件夹路径，也不是获取特定文件所有的路径。
比如我打开了C:\Program Files，我通过右键运行放在D盘的脚本，获取到我正在用的文件夹地址“C:\Program Files“

Batcher

回复 1# wind5win


test-1.bat

@echo off
powershell "@((New-Object -com shell.application).Windows()).Document.Folder.Self.Path"
pause
复制代码

wind5win

回复 2# Batcher


  你好，请问vbs里怎么写呢，我需要提取的路径在vbs中引用

wind5win

回复 2# Batcher
我填加右键调用bat，再使bat运行vbs，结果是在任意右键位置生成日期文件。现在有个问题是在网络共享盘里运行vbs创建文件夹失败，需要加共享网盘目录

Windows Registry Editor Version 5.00

[HKEY_CLASSES_ROOT\Directory\Background\shell\datefolder]

"MUIVerb"="新建日期文件夹"
"Icon"="shell32.dll,20"
"Position"="top"

[HKEY_CLASSES_ROOT\Directory\Background\shell\datefolder\command]
@="C:\\portable\\adddatefolder.bat"

@echo off
cls
set a=20
set b=1

:re 
set /a a+=2
set /a b+=1
mode con:cols=%a% lines=%b%
if %a% lss 4 goto re



::set rr="HKCU\Console\%%SystemRoot%%_system32_cmd.exe"
::reg delete %rr% /f>nul
::reg add %rr% /v "WindowPosition" /t REG_DWORD /d 0x012c0384 /f>nul

::if “%1”==”h” goto begin
::start mshta vbscript:createobject(“wscript.shell”).run(“”“%~nx0”” h”,0)(window.close)&&exit
::begin
call "C:\portable\adddatefolder.vbs">nul
复制代码

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("输入文件夹名称")
i = "-" & str
Fldr1 = d & str
Fldr2 = d & i
'tt1 = fso.FolderExists(fldr1) '存在返回true;不存在返回false
'tt2 = fso.FolderExists(fldr2) '存在返回true;不存在返回false
'If str = false Then
If isempty(str) or str = "" Then
fso.CreateFolder Fldr1
Else
fso.CreateFolder Fldr2
'ws.run Fldr2
End If
Set fso = nothing
Set ws = nothing

77七

Set objShell = CreateObject("Shell.Application")
Set objWindows = objShell.Windows

For Each Window in objWindows
    If InStr(1, Window.FullName, "explorer.exe", vbTextCompare) > 0 Then
        Path = Window.Document.Folder.Self.Path
        If Not Path = Replace(WScript.ScriptFullName, WScript.ScriptName, "") Then
            WScript.Echo Path
        End If
    End If
Next

WScript.Echo "Press any key to continue..."
WScript.StdIn.Read(1)
复制代码

我问了下ai，写了个类似的，让ai排除脚本所在目录，一直不成功
23：35编辑

我又问了一下ai
获取最后打开的windows资源管理器窗口目录

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
        Exit For
    End If
Next

' Output the directory path of the last opened window
WScript.Echo strFolder
复制代码

77七

回复 2# Batcher


   谢谢站长分享！感觉以后可以多一个方式执行批处理了，写成批处理排除批处理脚本所在目录，只打开两个资源管理器窗口，可以直接cd 到待处理的目录工作了，很实用！

wind5win

回复 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
复制代码

wind5win

回复 1# wind5win

chishingchan

不明白你的问题竟与格式时间扯上关系！