Excel에서 실행중인 CMD 행 목록

Question

누구든지 다음 요구 사항을 만족시킬 수 있습니까?

요구 사항 A :

내가 CMD에서 명령 문자열의 목록을 실행하는 루프를 만들고 싶습니다 한 열 C.에서 아닌 값 거기에 나는 내가를 정의 할 필요가 있다고 생각 첫 번째 줄의 변수 i는 항상 동일하므로 Shell()을 실행하여 i 열 F.의 해당 셀에서 명령 문자열을 가져옵니다. Cells(i, "C")이 비어 있지 않은 경우 계속 i을 1 씩 늘립니다.

요구 사항 B :

또한이 매크로를 링크하여 선택한 디렉토리의 모든 파일을 나열하는 이전 매크로에 의해 셀에 보관 된 디렉토리에서 작업하고 싶습니다.

이 내가 어떤 루프없이, 무엇을 가지고

..

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을 사용할 수 있지만 프로그래밍 언어 나 명령 프롬프트는 사용할 수 없습니다. 이 때문에 나는 배치 파일을 만드는 것 같이 here을 제안하는 것과 같은 조치를 취하지 않으려 고합니다. 그것은 내 친구를 복잡하게 만듭니다.

내가 가진 엑셀 파일을 만들었습니다

Tab 1 - 새 파일 이름 목록을 생성하는 템플릿 시트를. 여러 셀을 연결하고, 파일 형식을 추가하고, 셀 범위에 출력함으로써 작동합니다. 탭이 범위에 두 개의 링크 CMD

의 이름을 변경 명령 ​​문자열

Tab 2 만들기 -

Button 1 - 아래 Sub rename()합니다. VBA는

F 열이 A1_B1_C1.xlsx "탭 1 예 르네"파일 1 "입력"

에 따라 파일 B로 파일 A의 이름을 변경하는 명령 줄을 생성 열 C에서 선택한 디렉토리에있는 파일을 나열하려면 Button 2은 - 버튼 1에서 선택한 디렉토리를 선택합니다 모든 이름 변경 명령 ​​문자열을 통해 실행 이름 바꾸기 매크로 (요구 사항 1 위 2)을 의미하는 동안 해당 디렉토리

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 

Answer 1

주의 사항 :

1) 나는 전체가 아니다. 내가 어떻게 명확한 요소를 포함하는 목표를 성취 할 수있는 방법을 제공 할 수 있도록 데이터 등의 레이아웃이 명확하게 정리되어 있습니다.

2) 솔직하게 말해서, 개인적으로, 워크 시트로 거꾸로 가고 앞으로 가기보다는 배열이나 사전을 최대한 많이 사용합니다.

그러나 ...요구 사항의 개요 및 거칠고 준비가 조금 다음

, 우리는이 : 사용

1) 매크로 rename (ListFiles로하고 몇 가지 사소한 조작과 이름) 밖으로 선택한 폴더 이름을 쓰고 Worksheets("Batch Rename of Files")에서 Range("A1") 및 열 C.

2) Worksheets("Batch Rename of Files")의 F 열에서 이름 바꾸기 쉘 명령을 데리러 두 번째 매크로 RenameFiles 사용을위한 파일 이름에; 이를 바탕 화면의 배치 파일에 기록하십시오. 작업 디렉토리를 Range("A1")에 주어진 선택된 폴더로 설정하는 첫 번째 라인 명령을 추가하십시오 (요구 사항 A). 셸 명령은 .bat 파일을 실행하고 이름 바꾸기를 완료하며 (요구 사항 B) .bat 파일을 제거하는 줄이 있습니다.

나는 한 번에 하나씩 명령을 실행하는 열 F 범위를 반복하는 것보다 목표를 달성하는보다 효율적인 방법이라고 생각합니다.

필자는 다른 방식으로 코드를 최적화하려고하지 않았습니다. 기존에 입력 한 기능을 몇 가지 추가했습니다. 요구 사항을 달성하는 데 도움이되는 여러 가지 개선 사항이 있습니다.

어떻게 진행되는지 알려주세요.

TAB1 레이아웃 (새 파일 이름을 포함하는 시트) :

파일 레이아웃 일괄 이름 바꾸기 (첫 번째 매크로 버튼의 시트가 포함 출력) :

ListFiles : FileRenaming라는 표준 모듈에서

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 

:

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 파일의 워크 시트 일괄 이름 바꾸기에

버튼 코드 :

여기 VERSION 2

그리고하는 사전을 사용하고, 다른 하나 개의 서브에서 파라미터를 전달하는 다른 버전이다. 따라서, 이는 오직 하나의 버튼 푸시 동작과 연관된 매크로, 즉 제 2 버튼이 존재하지 않을 것이다. 단일 단추는 ListFiles을 호출하고 차례로 두 번째 매크로를 호출합니다. 도구> 참조로 이동하여 Microsoft Scripting Runtime 참조를 추가해야 할 수 있습니다.

탭 1의 Col D에 폴더에있는 파일 수 (폴더의 파일을 얻기위한 스크립트 별)와 일치하는 새 파일 이름이 있다고 가정합니다. 쓸모없는 타입 레퍼런스를 삭제했습니다. RubberDuck VBA Add-in에 추가 기능을 추가하여이 파일들을 선택했습니다.

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 

스크립트 실행 시간 기준 :

01 다른 표준 모듈에서

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 

:

하나 개의 표준 모듈

데스크톱 경로를 찾는 추가 방법입니다. Allen Wyatt에서 촬영 : 표준 모듈에서

다음 추가

desktopPath = GetDesktop 

으로

deskTopPath = Environ$("USERPROFILE") & "\Desktop" 

: 코드의 나머지 부분에서 그런

Public Function GetDesktop() As String 
    Dim oWSHShell As Object 

    Set oWSHShell = CreateObject("WScript.Shell") 
    GetDesktop = oWSHShell.SpecialFolders("Desktop") 
    Set oWSHShell = Nothing 
End Function 

이 deskTopPath =..... 등의 인스턴스를 교체