运行 来自 Excel 的 CMD 行列表
Running List of CMD lines from Excel
任何人都可以帮助满足以下要求吗？
需求A：
我想创建一个循环到 运行 CMD 中的命令字符串列表，只要 C 列中有一个非零值。我想我需要为我的变量定义一个变量 i起始行始终相同，然后是 运行 Shell()，从行 i、F 列的相应单元格中拉出命令字符串。而 Cells(i, "C")不是空白，继续，将 i 增加 1.
需求B：
我还想 link 这个宏在一个目录中工作，该目录由一个较早的宏存放在一个单元格中，该宏列出了选定目录中的所有文件。
这是我的，没有任何循环..
Sub Run_Renaming()
Dim CommandString As Long
Dim i As Integer
i = 5
'Other steps:
'1 - need to pick up variable (directory of files listed, taken from first macro
'when doing manually, I opened command, went to correct directory, then pasted
'the commands. I'm trying to handle pasting the commands. I'm not sure if I need
'something to open CMD from VBA, then run through the below loop, or add opening
'CMD and going to the directory in each iteration of the below loop...
'2 - Need to say - Loop below text if Worksheets("Batch Rename of Files").Cells(i, "C").Value is no blank
CommandString = Worksheets("Batch Rename of Files").Cells(i, "F").Value
Call Shell("cmd.exe /S /K" & CommandString, vbNormalFocus)
'Other steps:
'3 - need to increase i by 1
'4 - need to check if C column is blank or not
'5 - need to end of C column is blank
End Sub
背景：
我正在为朋友创建一个文件重命名工具。他们可以使用 excel，但不能使用编程语言或命令提示符。因此，我不想执行任何步骤，例如建议 创建批处理文件，这会使我朋友的事情变得复杂。
我创建了一个 excel 文件：
Tab 1 - 用于创建新文件名列表的模板 sheet。通过连接多个单元格、添加文件类型并输出到一系列单元格来工作。在为 CMD
创建重命名命令字符串时，将两个 links 切换到此范围
Tab 2 -
Button 1 - Sub rename() 下面。 VBA 列出 C 列中选定目录中的文件
F 列创建一个命令行，该命令行将根据选项卡 1 的输入将文件 A 重命名为文件 B，即 ren "File 1" "A1_B1_C1.xlsx"
Button 2 - 指的是一个重命名宏（上面的要求 1 和 2），它从按钮 1 和 运行s 通过所有重命名命令字符串在该目录中选取所选目录
Sub rename()
Dim xRow As Long
Dim xDirect$, xFname$, InitialFoldr$
InitialFoldr$ = "C:\"
Worksheets("Batch Rename of Files").Activate
Worksheets("Batch Rename of Files").Range("C4").Activate
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select a folder to list Files from"
.InitialFileName = InitialFoldr$
.Show
If .SelectedItems.Count <> 0 Then
xDirect$ = .SelectedItems(1) & "\"
xFname$ = Dir(xDirect$, 7)
Do While xFname$ <> ""
ActiveCell.Offset(xRow) = xFname$
xRow = xRow + 1
xFname$ = Dir
Loop
End If
End With
End Sub
注意事项：
1) 我不完全清楚你的数据等是如何布局的，所以我提供了一种实现你目标的方法，其中涉及我清楚的元素。
2) 老实说，就我个人而言，我会尽可能多地使用数组或字典，而不是在工作表中来回切换。
然而...
根据您的要求大纲和一些粗略准备，我们有：
1) 使用您的宏 rename（重命名为 ListFiles 并进行一些小的调整）将所选文件夹名称写入 Range("A1") in Worksheets("Batch Rename of Files") 并且C 列的文件名。
2) 使用第二个宏 RenameFiles 从 Worksheets("Batch Rename of Files") 的 F 列获取重命名 shell 命令；将这些写到桌面上的批处理文件中；添加一个额外的第一行命令，将工作目录设置为 Range("A1") 中给出的所选文件夹（要求 A）。 shell命令执行.bat文件，完成重命名（需求B）然后有一行删除.bat文件。
我猜这是一种比循环列 F 范围一次执行一个命令更有效的实现目标的方法。
我没有试图以任何进一步的方式优化代码（我已经添加了一些现有的类型化函数。）还有许多其他可以进行的改进，但这是为了帮助您实现您的要求。
让我知道进展如何！
Tab1 布局（Sheet 包含新文件名）:
文件布局的批量重命名（Sheet 包含第一个宏和按钮的输出）:
文件的工作表批量重命名布局
在名为 ListFiles 的标准模块中：
Option Explicit
Public Sub ListFilesInDirectory()
Dim xRow As Long
Dim xDirect$, xFname$, InitialFoldr$ 'type hints not really needed
Dim wb As Workbook
Dim wsTab2 As Worksheet
Set wb = ThisWorkbook
Set wsTab2 = wb.Worksheets("Batch Rename of Files")
InitialFoldr$ = "C:\"
Dim lastRow As Long
lastRow = wsTab2.Cells(wsTab2.Rows.Count, "C").End(xlUp).Row
wsTab2.Range("C4:C" & lastRow).ClearContents 'Get rid of any existing file names
wsTab2.Range("C4").Activate
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select a folder to list Files from"
.InitialFileName = InitialFoldr$
.Show
If .SelectedItems.Count <> 0 Then
xDirect$ = .SelectedItems(1) & "\"
xFname$ = Dir(xDirect$, 7)
wsTab2.Range("A1") = xDirect$
Do While xFname$ <> vbNullString
ActiveCell.Offset(xRow) = xFname$
xRow = xRow + 1
xFname$ = Dir
Loop
End If
End With
End Sub
在名为 FileRenaming 的标准模块中：
Option Explicit
Sub RenameFiles()
Dim fso As New FileSystemObject
Dim stream As TextStream
Dim strFile As String
Dim strPath As String
Dim strData As Range
Dim wb As Workbook
Dim wsTab2 As Worksheet
Dim currRow As Range
Set wb = ThisWorkbook
Set wsTab2 = wb.Worksheets("Batch Rename of Files")
strPath = wsTab2.Range("A1").Value2
If strPath = vbNullString Then
MsgBox "Please ensure that Worksheet Batch Rename of Files has a directory path in cell A1"
Else
If Right$(Trim$(strPath), 1) <> "\" Then strPath = strPath & "\"
strFile = "Rename.bat"
Dim testString As String
Dim deskTopPath As String
deskTopPath = Environ$("USERPROFILE") & "\Desktop" 'get desktop path as this is where .bat file will temporarily be saved
testString = fso.BuildPath(deskTopPath, strFile) 'Check if .bat already exists and delete
If Len(Dir(testString)) <> 0 Then
SetAttr testString, vbNormal
Kill testString
End If
Set stream = fso.CreateTextFile(deskTopPath & "\" & strFile, True) 'create the .bat file
Dim lastRow As Long
lastRow = wsTab2.Cells(wsTab2.Rows.Count, "C").End(xlUp).Row
Set strData = wsTab2.Range("F4:F" & lastRow) 'Only execute for as many new file names as present in Col C (in place of your until blank requirement)
stream.Write "CD /D " & strPath & vbCrLf
For Each currRow In strData.Rows 'populate the .dat file
stream.Write currRow.Value & vbCrLf
Next currRow
stream.Close
Call Shell(testString, vbNormalFocus)
Application.Wait (Now + TimeValue("0:00:01")) 'As sometime re-naming doesn't seem to happen without a pause before removing .bat file
Kill testString
MsgBox ("Renaming Complete")
End If
End Sub
工作表批量重命名文件中的按钮代码
Private Sub CommandButton1_Click()
ListFilesInDirectory
End Sub
Private Sub CommandButton2_Click()
RenameFiles
End Sub
.bat 文件内容示例:
版本 2
这是一个不同的版本，它使用字典并将参数从一个子程序传递到另一个子程序。因此，这将是一个仅与一个按钮按下操作相关联的宏，即不会有第二个按钮。单个按钮会调用 ListFiles，后者又会调用第二个宏。可能需要您进入工具 > 参考并添加 Microsoft 脚本运行时参考。
假设选项卡 1 的 Col D 中新文件名的数量与在文件夹中找到的文件数量相匹配（根据您获取文件夹中文件的脚本）。我已将过时的类型 references.Shout 移出到 RubberDuck VBA 加载项团队，以便加载项拾取它们。
在一个标准模块中：
Option Explicit
Public Sub ListFiles()
Dim xDirect As String, xFname As String, InitialFoldr As String
Dim wb As Workbook
Dim ws As Worksheet
Dim dict As New Scripting.Dictionary
Dim counter As Long
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Tab1") 'Worksheet where new file names are
counter = 4 'row where new file names start
InitialFoldr = "C:\"
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select a folder to list Files from"
.InitialFileName = InitialFoldr
.Show
If .SelectedItems.Count <> 0 Then
xDirect = .SelectedItems(1) & "\"
xFname = Dir(xDirect, 7)
Do While xFname <> vbNullString
If Not dict.Exists(xFname) Then
dict.Add xFname, ws.Cells(counter, "D") 'Or which ever column holds new file names. This add to the dictionary the current name and new name
counter = counter + 1
xFname = Dir
End If
Loop
End If
End With
RenameFiles xDirect, dict 'pass directory path and dictionary to renaming sub
End Sub
在另一个标准模块中:
Public Sub RenameFiles(ByVal folderpath As String, ByRef dict As Dictionary)
Dim fso As New FileSystemObject
Dim stream As TextStream
Dim strFile As String
Dim testString As String
Dim deskTopPath As String
strFile = "Rename.bat"
deskTopPath = Environ$("USERPROFILE") & "\Desktop"
testString = fso.BuildPath(deskTopPath, strFile)
'See if .dat file of same name already on desktop and delete (you could overwrite!)
If Len(Dir(testString)) <> 0 Then
SetAttr testString, vbNormal
Kill testString
End If
Set stream = fso.CreateTextFile(testString, True)
stream.Write "CD /D " & folderpath & vbCrLf
Dim key As Variant
For Each key In dict.Keys
stream.Write "Rename " & folderpath & key & " " & dict(key) & vbCrLf 'write out the command instructions to the .dat file
Next key
stream.Close
Call Shell(testString, vbNormalFocus)
Application.Wait (Now + TimeValue("0:00:01")) 'As sometime re-naming doesn't seem to happen without a pause before removing .bat file
Kill testString
' MsgBox ("Renaming Complete")
End Sub
脚本运行时间参考：
添加运行时间参考
查找桌面路径的其他方法。摘自 Allen Wyatt:
在标准模块中添加以下内容：
Public Function GetDesktop() As String
Dim oWSHShell As Object
Set oWSHShell = CreateObject("WScript.Shell")
GetDesktop = oWSHShell.SpecialFolders("Desktop")
Set oWSHShell = Nothing
End Function
然后在其余代码中替换 deskTopPath =..... 的任何实例，例如：
deskTopPath = Environ$("USERPROFILE") & "\Desktop"
有
desktopPath = GetDesktop
任何人都可以帮助满足以下要求吗？
需求A：
我想创建一个循环到 运行 CMD 中的命令字符串列表，只要 C 列中有一个非零值。我想我需要为我的变量定义一个变量 i起始行始终相同，然后是 运行 Shell()，从行 i、F 列的相应单元格中拉出命令字符串。而 Cells(i, "C")不是空白，继续，将 i 增加 1.
需求B：
我还想 link 这个宏在一个目录中工作，该目录由一个较早的宏存放在一个单元格中，该宏列出了选定目录中的所有文件。
这是我的，没有任何循环..
Sub Run_Renaming()
Dim CommandString As Long
Dim i As Integer
i = 5
'Other steps:
'1 - need to pick up variable (directory of files listed, taken from first macro
'when doing manually, I opened command, went to correct directory, then pasted
'the commands. I'm trying to handle pasting the commands. I'm not sure if I need
'something to open CMD from VBA, then run through the below loop, or add opening
'CMD and going to the directory in each iteration of the below loop...
'2 - Need to say - Loop below text if Worksheets("Batch Rename of Files").Cells(i, "C").Value is no blank
CommandString = Worksheets("Batch Rename of Files").Cells(i, "F").Value
Call Shell("cmd.exe /S /K" & CommandString, vbNormalFocus)
'Other steps:
'3 - need to increase i by 1
'4 - need to check if C column is blank or not
'5 - need to end of C column is blank
End Sub
背景：
我正在为朋友创建一个文件重命名工具。他们可以使用 excel，但不能使用编程语言或命令提示符。因此，我不想执行任何步骤，例如建议
我创建了一个 excel 文件：
Tab 1 - 用于创建新文件名列表的模板 sheet。通过连接多个单元格、添加文件类型并输出到一系列单元格来工作。在为 CMD
Tab 2 -
Button 1 - Sub rename() 下面。 VBA 列出 C 列中选定目录中的文件
F 列创建一个命令行，该命令行将根据选项卡 1 的输入将文件 A 重命名为文件 B，即 ren "File 1" "A1_B1_C1.xlsx"
Button 2 - 指的是一个重命名宏（上面的要求 1 和 2），它从按钮 1 和 运行s 通过所有重命名命令字符串在该目录中选取所选目录
Sub rename()
Dim xRow As Long
Dim xDirect$, xFname$, InitialFoldr$
InitialFoldr$ = "C:\"
Worksheets("Batch Rename of Files").Activate
Worksheets("Batch Rename of Files").Range("C4").Activate
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select a folder to list Files from"
.InitialFileName = InitialFoldr$
.Show
If .SelectedItems.Count <> 0 Then
xDirect$ = .SelectedItems(1) & "\"
xFname$ = Dir(xDirect$, 7)
Do While xFname$ <> ""
ActiveCell.Offset(xRow) = xFname$
xRow = xRow + 1
xFname$ = Dir
Loop
End If
End With
End Sub
注意事项：
1) 我不完全清楚你的数据等是如何布局的，所以我提供了一种实现你目标的方法，其中涉及我清楚的元素。
2) 老实说，就我个人而言，我会尽可能多地使用数组或字典，而不是在工作表中来回切换。
然而...
根据您的要求大纲和一些粗略准备，我们有：
1) 使用您的宏 rename（重命名为 ListFiles 并进行一些小的调整）将所选文件夹名称写入 Range("A1") in Worksheets("Batch Rename of Files") 并且C 列的文件名。
2) 使用第二个宏 RenameFiles 从 Worksheets("Batch Rename of Files") 的 F 列获取重命名 shell 命令；将这些写到桌面上的批处理文件中；添加一个额外的第一行命令，将工作目录设置为 Range("A1") 中给出的所选文件夹（要求 A）。 shell命令执行.bat文件，完成重命名（需求B）然后有一行删除.bat文件。
我猜这是一种比循环列 F 范围一次执行一个命令更有效的实现目标的方法。
我没有试图以任何进一步的方式优化代码（我已经添加了一些现有的类型化函数。）还有许多其他可以进行的改进，但这是为了帮助您实现您的要求。
让我知道进展如何！
Tab1 布局（Sheet 包含新文件名）:
文件布局的批量重命名（Sheet 包含第一个宏和按钮的输出）:
文件的工作表批量重命名布局
在名为 ListFiles 的标准模块中：
Option Explicit
Public Sub ListFilesInDirectory()
Dim xRow As Long
Dim xDirect$, xFname$, InitialFoldr$ 'type hints not really needed
Dim wb As Workbook
Dim wsTab2 As Worksheet
Set wb = ThisWorkbook
Set wsTab2 = wb.Worksheets("Batch Rename of Files")
InitialFoldr$ = "C:\"
Dim lastRow As Long
lastRow = wsTab2.Cells(wsTab2.Rows.Count, "C").End(xlUp).Row
wsTab2.Range("C4:C" & lastRow).ClearContents 'Get rid of any existing file names
wsTab2.Range("C4").Activate
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select a folder to list Files from"
.InitialFileName = InitialFoldr$
.Show
If .SelectedItems.Count <> 0 Then
xDirect$ = .SelectedItems(1) & "\"
xFname$ = Dir(xDirect$, 7)
wsTab2.Range("A1") = xDirect$
Do While xFname$ <> vbNullString
ActiveCell.Offset(xRow) = xFname$
xRow = xRow + 1
xFname$ = Dir
Loop
End If
End With
End Sub
在名为 FileRenaming 的标准模块中：
Option Explicit
Sub RenameFiles()
Dim fso As New FileSystemObject
Dim stream As TextStream
Dim strFile As String
Dim strPath As String
Dim strData As Range
Dim wb As Workbook
Dim wsTab2 As Worksheet
Dim currRow As Range
Set wb = ThisWorkbook
Set wsTab2 = wb.Worksheets("Batch Rename of Files")
strPath = wsTab2.Range("A1").Value2
If strPath = vbNullString Then
MsgBox "Please ensure that Worksheet Batch Rename of Files has a directory path in cell A1"
Else
If Right$(Trim$(strPath), 1) <> "\" Then strPath = strPath & "\"
strFile = "Rename.bat"
Dim testString As String
Dim deskTopPath As String
deskTopPath = Environ$("USERPROFILE") & "\Desktop" 'get desktop path as this is where .bat file will temporarily be saved
testString = fso.BuildPath(deskTopPath, strFile) 'Check if .bat already exists and delete
If Len(Dir(testString)) <> 0 Then
SetAttr testString, vbNormal
Kill testString
End If
Set stream = fso.CreateTextFile(deskTopPath & "\" & strFile, True) 'create the .bat file
Dim lastRow As Long
lastRow = wsTab2.Cells(wsTab2.Rows.Count, "C").End(xlUp).Row
Set strData = wsTab2.Range("F4:F" & lastRow) 'Only execute for as many new file names as present in Col C (in place of your until blank requirement)
stream.Write "CD /D " & strPath & vbCrLf
For Each currRow In strData.Rows 'populate the .dat file
stream.Write currRow.Value & vbCrLf
Next currRow
stream.Close
Call Shell(testString, vbNormalFocus)
Application.Wait (Now + TimeValue("0:00:01")) 'As sometime re-naming doesn't seem to happen without a pause before removing .bat file
Kill testString
MsgBox ("Renaming Complete")
End If
End Sub
工作表批量重命名文件中的按钮代码
Private Sub CommandButton1_Click()
ListFilesInDirectory
End Sub
Private Sub CommandButton2_Click()
RenameFiles
End Sub
.bat 文件内容示例:
版本 2
这是一个不同的版本，它使用字典并将参数从一个子程序传递到另一个子程序。因此，这将是一个仅与一个按钮按下操作相关联的宏，即不会有第二个按钮。单个按钮会调用 ListFiles，后者又会调用第二个宏。可能需要您进入工具 > 参考并添加 Microsoft 脚本运行时参考。
假设选项卡 1 的 Col D 中新文件名的数量与在文件夹中找到的文件数量相匹配（根据您获取文件夹中文件的脚本）。我已将过时的类型 references.Shout 移出到 RubberDuck VBA 加载项团队，以便加载项拾取它们。
在一个标准模块中：
Option Explicit
Public Sub ListFiles()
Dim xDirect As String, xFname As String, InitialFoldr As String
Dim wb As Workbook
Dim ws As Worksheet
Dim dict As New Scripting.Dictionary
Dim counter As Long
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Tab1") 'Worksheet where new file names are
counter = 4 'row where new file names start
InitialFoldr = "C:\"
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Please select a folder to list Files from"
.InitialFileName = InitialFoldr
.Show
If .SelectedItems.Count <> 0 Then
xDirect = .SelectedItems(1) & "\"
xFname = Dir(xDirect, 7)
Do While xFname <> vbNullString
If Not dict.Exists(xFname) Then
dict.Add xFname, ws.Cells(counter, "D") 'Or which ever column holds new file names. This add to the dictionary the current name and new name
counter = counter + 1
xFname = Dir
End If
Loop
End If
End With
RenameFiles xDirect, dict 'pass directory path and dictionary to renaming sub
End Sub
在另一个标准模块中:
Public Sub RenameFiles(ByVal folderpath As String, ByRef dict As Dictionary)
Dim fso As New FileSystemObject
Dim stream As TextStream
Dim strFile As String
Dim testString As String
Dim deskTopPath As String
strFile = "Rename.bat"
deskTopPath = Environ$("USERPROFILE") & "\Desktop"
testString = fso.BuildPath(deskTopPath, strFile)
'See if .dat file of same name already on desktop and delete (you could overwrite!)
If Len(Dir(testString)) <> 0 Then
SetAttr testString, vbNormal
Kill testString
End If
Set stream = fso.CreateTextFile(testString, True)
stream.Write "CD /D " & folderpath & vbCrLf
Dim key As Variant
For Each key In dict.Keys
stream.Write "Rename " & folderpath & key & " " & dict(key) & vbCrLf 'write out the command instructions to the .dat file
Next key
stream.Close
Call Shell(testString, vbNormalFocus)
Application.Wait (Now + TimeValue("0:00:01")) 'As sometime re-naming doesn't seem to happen without a pause before removing .bat file
Kill testString
' MsgBox ("Renaming Complete")
End Sub
脚本运行时间参考：
添加运行时间参考
查找桌面路径的其他方法。摘自 Allen Wyatt:
在标准模块中添加以下内容：
Public Function GetDesktop() As String
Dim oWSHShell As Object
Set oWSHShell = CreateObject("WScript.Shell")
GetDesktop = oWSHShell.SpecialFolders("Desktop")
Set oWSHShell = Nothing
End Function
然后在其余代码中替换 deskTopPath =..... 的任何实例，例如：
deskTopPath = Environ$("USERPROFILE") & "\Desktop"
有
desktopPath = GetDesktop