人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

エクセルVBAについて質問です。
Dドライブ内にあるXXというフォルダの中(D:\XX)にある
全てのファイルに記入されている改行マーク(↑)を
「vbCrLf」に置換するというマクロを作ってください。

具体的にはXXフォルダ内にある全てのファイルで
下記のページにある動作を行うマクロを作ってください。
http://q.hatena.ne.jp/1162632248
その際、↑↑と連続している場合も考慮に入れて、
作成していただくようお願いします。

●質問者: taroemon
●カテゴリ:コンピュータ
✍キーワード:VBA エクセル ドライブ ファイル フォルダ
○ 状態 :終了
└ 回答数 : 2/2件

▽最新の回答へ

1 ● llusall
●150ポイント

以下のVBScriptを使用してはいかがでしょうか?

使用方法

以下のソースの■部分を適宜修正して、

「一括置換.vbs」などのファイル名でデスクトップ等に保存します。

アイコンをダブルクリックすると実行されます。

Option Explicit

Dim REP_STR_BEFORE

Dim REP_STR_AFTER

Const TARGET_FOLDER = "D:\XX"    '■置換するファイルが入っている場所を指定します。

Const RESULT_FOLDER = "D:\XX2"    '■置換したファイルを入れる場所を指定します。

REP_STR_BEFORE = vbCrLf     '■置換前の文字列を指定します。(この場合「改行」)

REP_STR_AFTER  = "↓"       '■置換後の文字列を指定します。(この場合「↓」文字)

Call RepMain()

Sub RepMain()

    Dim sFname

    Dim objFS, objTXT, objTXT2, sText

    Dim objFile,objFolder

    Err.Clear

    Set objFS   = CreateObject("Scripting.FileSystemObject")

    If objFS.FolderExists(RESULT_FOLDER) Then

    Else

        objFS.CreateFolder (RESULT_FOLDER)

    End If

    Set objFolder = objFS.GetFolder(TARGET_FOLDER)

    'ファイル数の処理を実行

    For Each objFile In objFolder.Files

        sFname = objFile.Name

        Set objTXT  = objFS.OpenTextFile( TARGET_FOLDER & "\" & sFname, 1, False )

        Set objTXT2 = objFS.CreateTextFile( RESULT_FOLDER & "\" & sFname, True )

        sText = Replace(objTXT.ReadAll,REP_STR_BEFORE,REP_STR_AFTER)

        objTXT2.WriteLine(sText)

        objTXT.Close

        Set objTXT  = Nothing

        objTXT2.Close

        Set objTXT2 = Nothing

    Next

    Set objFolder = Nothing

    MsgBox "終わり。", vbInformation

End Sub

エクセルのマクロとして使用したい場合は、標準モジュールに記述し、

以下のように修正すれば良いかと思います。

'コメントにします

'Call RepMain()

'パブリックにします

Public Sub RepMain()

◎質問者からの返答

ご回答ありがとうございます。

すごく良いアイデアですね。

こういう方法があるのを知りませんでした。

とても勉強になりました。

ところで2つ質問があります。

まず実行すると、

エラー:「終了していない文字列型の定数です」

コード:800A04009

ソース:VBScriptコンパイルエラー

とひょうじされてエラーが出ます。

どうしたらよいのでしょうか?

エクセルのマクロとして使用した場合、

どの部分を上記のように設定すれば良いのでしょうか?

以上よろしくご回答ください。


2 ● llusall
●35ポイント

再回答すみません。

エクセルマクロで使用するのであれば、次のようにしてください。

なお、VBScriptで実行した場合、コメントのエラーは確認できませんでした。

また、エラーが表示されるようであれば、コメントください。

(行番号も出ればそれも教えてください。この質問・回答へのコメントも有効にしていただけると良いかと思います。)

Option Explicit

    

Const TARGET_FOLDER = "D:\XX"    '■置換するファイルが入っている場所を指定します。

Const RESULT_FOLDER = "D:\XX2"    '■置換したファイルを入れる場所を指定します。

Public Sub RepMain()

    Dim sFname

    Dim objFS, objTXT, objTXT2, sText

    Dim objFile, objFolder

    Dim REP_STR_BEFORE

    Dim REP_STR_AFTER

    REP_STR_BEFORE = vbCrLf     '■置換前の文字列を指定します。(この場合「改行」)

    REP_STR_AFTER = "↓"        '■置換後の文字列を指定します。(この場合「↓」文字)

    Err.Clear

    

    Set objFS = CreateObject("Scripting.FileSystemObject")

    If objFS.FolderExists(RESULT_FOLDER) Then

    Else

        objFS.CreateFolder (RESULT_FOLDER)

    End If

    

    Set objFolder = objFS.GetFolder(TARGET_FOLDER)

    

    'ファイル数の処理を実行

    For Each objFile In objFolder.Files

        sFname = objFile.Name

        Set objTXT = objFS.OpenTextFile(TARGET_FOLDER & "\" & sFname, 1, False)

        Set objTXT2 = objFS.CreateTextFile(RESULT_FOLDER & "\" & sFname, True)

        sText = Replace(objTXT.ReadAll, REP_STR_BEFORE, REP_STR_AFTER)

        objTXT2.WriteLine (sText)

        objTXT.Close

        Set objTXT = Nothing

        objTXT2.Close

        Set objTXT2 = Nothing

    Next

    Set objFolder = Nothing

    MsgBox "終わり。", vbInformation

End Sub

◎質問者からの返答

再びのご回答ありがとうございます。

とても助かります。

VBScriptを実行すると

エラーには行14、文字20と出ます。

ちなみにエクセルマクロでは実行できましたが、

このVBScriptを非常に気に入ってますので、

どうしたらよいかご回答いただけれるととても嬉しいです。

私はメモ帳にいただいたスクリプトをコピペして、

「一括置換.vbs」という名前で保存しましたが、

これがいけなかったのでしょうか?

質問中にコメントが書けるように設定しましたが、

再回答に対してもポイントをお支払いするのは

当然のことと考えています。

私としましてはわからないことだらけですので、

最後まで教えていただけることの方が重要です。

同一人物の回答も5回まで受け付けるよう設定しましたので、

何度でもコチラにご回答いただければ幸いです。

以上、よろしくお願いします。

関連質問


●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ