Excelのマクロについて教えてください。

Question

下記のマクロはネットから参照したマクロで、マクロを実行すると指定フォルダが圧縮できます。
このマクロでが圧縮対象のフォルダを
 targetPath = "C:\Users\160931\Desktop\ファイル更新（最新）\テスト物件\12345678-5_交付用"
 '作成するZIPファイルのパスを
    zipFilePath = "C:\Users\160931\Desktop\ファイル更新（最新）\テスト物件\12345678-5_交付用.zip"
に指定しておりますが、
この指定を
マクロ設定ブックと同じフォルダ内にある、フォルダ「12345678-5_交付用」に変更出来る方法を教えてください。
尚、圧縮対象フォルダは1つしか無く、「_交付用」は固定フォルダ名になりますが、
「_交付用」から前の部分（12345678-5）は物件毎に変更になる為、
' フォルダ名が「8桁の英数字-1_交付用」というパターンに一致する場合
If folderName Like "########-#_交付用" Then
のような設定を希望いたします。
現状のマクロ
Sub フォルダを圧縮()
 Dim targetPath As String
    Dim zipFilePath As String
    Dim psCommand As String
    Dim wsh As Object
    Dim result As Integer
    
    'ZIP形式で圧縮するフォルダ(またはファイル)パスを指定
    targetPath = "C:\Users\160931\Desktop\ファイル更新（最新）\テスト物件\12345678-5_交付用"
    
    '作成するZIPファイルのパスを指定
    zipFilePath = "C:\Users\160931\Desktop\ファイル更新（最新）\テスト物件\12345678-5_交付用.zip"
    
    '実行するPowerShellのコマンドレットを組み立て
    psCommand = "powershell -NoProfile -ExecutionPolicy Unrestricted Compress-Archive -Path " & targetPath & " -DestinationPath " & zipFilePath & " -Force"
    
    Set wsh = CreateObject("WScript.Shell")
    
    'PowerShellのコマンドレットを実行
    result = wsh.Run(Command:=psCommand, WindowStyle:=0, WaitOnReturn:=True)
    
    If (result = 0) Then
        MsgBox ("圧縮が正常終了しました。")
    Else
        MsgBox ("圧縮が異常終了しました。")
    End If
    
    '後片付け
    Set wsh = Nothing
    
End Sub
以上となります。
宜しくお願い致します。

tatsumaru77 · Accepted Answer

以下のようにしてください。

Sub フォルダを圧縮()
    Dim targetPath As String
    Dim zipFilePath As String
    Dim psCommand As String
    Dim wsh As Object
    Dim result As Integer
    Dim folname As String

folname = Dir(ThisWorkbook.path & "\" & "????????-?_交付用", vbDirectory)
    If folname = "" Then
        MsgBox ("該当フォルダなし")
        Exit Sub
    End If
    'ZIP形式で圧縮するフォルダ(またはファイル)パスを指定
    targetPath = ThisWorkbook.path & "\" & folname
    '作成するZIPファイルのパスを指定
    zipFilePath = targetPath & ".zip"
    
    '実行するPowerShellのコマンドレットを組み立て
    psCommand = "powershell -NoProfile -ExecutionPolicy Unrestricted Compress-Archive -Path " & targetPath & " -DestinationPath " & zipFilePath & " -Force"

Set wsh = CreateObject("WScript.Shell")

'PowerShellのコマンドレットを実行
    result = wsh.Run(Command:=psCommand, WindowStyle:=0, WaitOnReturn:=True)

If (result = 0) Then
        MsgBox ("圧縮が正常終了しました。")
    Else
        MsgBox ("圧縮が異常終了しました。")
    End If

'後片付け
    Set wsh = Nothing

End Sub

Excelのマクロについて教えてください。

以下のようにしてください。

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング