0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?

More than 3 years have passed since last update.

VBScriptで同一フォルダ内の全てのExcelと一太郎を一括置換する

Posted at

仕様

 このVBScriptと同じフォルダに入れた全てのExcelファイル、一太郎ファイルを確認なしで一括置換します。子フォルダ内のファイルは変更しません。
 手作業でファイルを開かなくてよいので楽で高速です。

主に異動時にす
平成→令和
前任者名前→後任者名前
などの置換作業に使っています。もちろん、いつ、誰がやったかを残しておきたいファイルまで置換しないよう気をつけてください。

スクリプト

VBScript
Option Explicit
    Dim bf, af
    bf = InputBox("このスクリプトが存在するフォルダ内の全てのExcelファイル,一太郎ファイルが置換対象となります。" & _
        vbLf & vbLf & "置換対象文字列を入力してください")
        If bf = "" Then
            Wscript.Quit
        Else
        af = InputBox("「" & bf & "」" & vbLf & "を置換する文字列を入力してください", , bf)
            If af = "" Then
            Wscript.Quit
            End If
        End If
    Dim ans
'実行確認を求めるメッセージボックスを表示
    ans = MsgBox("「" & bf & "」" & vbLf & "を" & vbLf & "「" & af & "」" & vbLf & "に置換しますか?", vbOKCancel + vbInformation, "最終確認")
        If ans = vbOK Then
            MsgBox "置換を開始します"
        Else
            MsgBox "処理を中止します"
            Wscript.Quit
        End If
        
    Dim ec, taro, fso, foldername, fld, f, filename
    Set ec = CreateObject("Excel.Application")
    Set taro = CreateObject("JXW.Application")
    Set fso = CreateObject("Scripting.FilesystemObject")
    foldername = fso.getparentfoldername(Wscript.ScriptFullname)
    Set fld = fso.getfolder(foldername)
    
    ec.Visible = False
    With ec.Application
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
    End With
    
    taro.Visible = False
    With taro.TaroLibrary
    .DisplayMode 0
    .ErrorBreakMode 1, 1, 0
    .WarningMode 0
    End With
    
    Dim p_file
    p_file = ""
    Dim t_file
    t_file = ""
    
        For Each f In fld.Files
            If f.Attributes = 32 Then
                    If fso.GetExtensionName(f.Path) = "xlsx" Or fso.GetExtensionName(f.Path) = "xlsm" Then
                        ec.Workbooks.Open foldername & "\" & f.Name
                        Dim i, sht
                            For i = 1 To ec.ActiveWorkbook.Sheets.Count
                                Set sht = ec.ActiveWorkbook.Sheets(i)
                                sht.Cells.Replace bf, af, 2
                            Next
            On Error Resume Next
            ec.Workbooks(f.Name).Close True
                If Err.Number = 1004 Then
                    p_file = p_file & vbLf & "「" & f.Name & "」"
                End If
            On Error GoTo 0
                    ElseIf fso.GetExtensionName(f.Path) = "jtd" Then
                        t_file = f.Name
                        taro.Documents.Open (foldername & "\" & f.Name)
                        
                        Dim j
                            For j = 1 To taro.TaroLibrary.GetSheetCount()
                                taro.TaroLibrary.ChangeCurrentSheet (j)
                                taro.TaroLibrary.ReplaceStringAll bf, af, 3, 0, 0
                            Next
                        taro.TaroLibrary.ChangeCurrentSheet (1)
                        taro.TaroLibrary.SaveDocument
                        taro.TaroLibrary.CloseDocumentWindow
                    End If
            End If
        Next
        
    With ec.Application
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
    End With

    With taro.TaroLibrary
    .DisplayMode 1
    .ErrorBreakMode 1, 1, 1
    .WarningMode 1
    End With

    Set ec = Nothing
    Set taro = Nothing

    Dim msg
    msg = "このバッチファイルが存在するフォルダ内の全てのExcelファイル・一太郎ファイルで" & vbLf & vbLf & "「" _
         & bf & "」" & vbLf & "が" & vbLf & "「" & af & "」" & vbLf & vbLf & "に置換されました。"
        If p_file <> "" Or t_file <> "" Then
            msg = msg & vbLf & vbLf & vbLf & vbLf & "※注" & vbLf
        End If
        If p_file <> "" Then
            msg = msg & "Excelファイル名:" & p_file & vbLf & "の保護されているシート又はセルの文字列は置換できませんでした"
        End If
        If t_file <> "" Then
            msg = msg & vbLf & vbLf & "一太郎ファイルを置換したときは空のウインドウを閉じてください"
        End If
    MsgBox msg
0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
0

Delete article

Deleted articles cannot be recovered.

Draft of this article would be also deleted.

Are you sure you want to delete this article?