ここから本文です

ExcelVBAで文字化けをなんとかしたい ExcelVBAでフォルダ名を取得し作業するマク...

nar********さん

2017/4/1718:13:47

ExcelVBAで文字化けをなんとかしたい
ExcelVBAでフォルダ名を取得し作業するマクロを組んで使っているのですが、

「嚙」のような機種依存文字があると?に文字化けしてしまい、処理ができません。
~?を使って文字化けした文字を検索してエラーとしようかと思いましたが反応せず、うまい対処の方法がわかりません。
うまい対処の方法がありましたら回答願えないでしょうか?

補足詳細な説明感謝しますが現状必要なのは文字化けしたフォルダを発見して警告するだけなのですよね…
文字化けした?を検索で発見できるようにしたりはできませんか?

閲覧数:
207
回答数:
3
お礼:
100枚

違反報告

ベストアンサーに選ばれた回答

プロフィール画像

カテゴリマスター

lin********さん

2017/4/1810:02:30

「VBScript」で組みましたので、「Windows限定」です。

このプログラムの特徴は、「D:\xyz」直下のサブフォルダを調べたい場合、「D:\xyz」にプログラムファイルを放り込んで、ダブルクリックするだけで、「嚙」のような文字が含まれるフォルダ名をがあった場合、「嚙」の文字を「■」にいったん、変えてしまいます。

もちろん、もう1つプログラムは用意していますので、エクセルの「VBA」実行後、2つ目のプログラムを実行させて、元のフォルダ名に戻してください。

ただし、1つ目のプログラムで、フォルダ内に「log.txt」というファイルを作成します。

この「log.txt」に、今現在のフォルダ名と、元々のフォルダ名を書き込んでいて、それを基に、元に戻していますので、絶対に「log.txt」を削除しないでください。

以下のプログラムを、メモ帳かテキストエディタに貼り付け、「~.vbs」という名前で保存します。

「~」の部分は、何でもかまいませんが、「.vbs」の部分は、必ず半角です。

できたプログラムファイル(「~.vbs」ファイル)を、「D:\xyz」直下のサブフォルダを調べたい場合は、「D:\xyz」フォルダに放り込んで、ダブルクリック(「シングルクリック」→「Enter」の方が確実)して、実行してください。

最後に「Finished!」と表示しますので、「OK」を押して、終了してください。

では、まず、1つ目です。

Option Explicit
Dim c, f, gf, m, n, i, so, tx, x
Set so = CreateObject("Scripting.FileSystemObject")
Set gf = so.GetFolder(".")
Set tx = so.OpenTextFile(gf & "\log.txt", 2, True, True)
For Each f In gf.SubFolders
x = f.Name
c = 0
n = ""
For i = 1 to Len(f.Name)
m = Mid(f.Name, i, 1)
If Asc(m) = 63 Then
c = 1
m = "■"
End If
n = n & m
Next
If c = 1 Then
tx.WriteLine(f.Name & vbTab & n)
f.Name = n
End If
Next
Set gf = Nothing
Set so = Nothing
MsgBox("Finished!")

簡単な説明です。

Option Explicit

「厳密に」というような意味ですが、気にしないでください。

Set so = CreateObject("Scripting.FileSystemObject")

ファイルやフォルダを扱えるようにしています。

Set gf = so.GetFolder(".")

プログラムファイル(「~.vbs」ファイル)自身が存在するフォルダを取得しています。

Set tx = so.OpenTextFile(gf & "\log.txt", 2, True, True)

「log.txt」を書き込み専用でなおかつ、「Unicode」で用意(「嚙」などがこれで扱えます)。

For Each f In gf.SubFolders

プログラムファイル(「~.vbs」ファイル)が存在する直下のサブフォルダを1つずつ調べます。

x = f.Name

元のサブフォルダ名を覚えておきます。

c = 0

フラグです。

n = ""

変数の初期化。

For i = 1 to Len(f.Name)
m = Mid(f.Name, i, 1)

みつかった、サブフォルダ名を頭から1文字ずつ調べます。

If Asc(m) = 63 Then

その1文字が「?」なら、

c = 1

フラグを「1」に(「?」が見つかった!)。

m = "■"

その1文字を「■」にする用意。

n = n & m

新たなファイル名を作成しています。

If c = 1 Then

もし、「?」が存在したら、

tx.WriteLine(f.Name & vbTab & n)

「log.txt」に元々のサブフォルダ名と新規に作成したサブフォルダ名を書き込んでいます。

f.Name = n

名前を変更しています。

End If
Next
Set gf = Nothing
Set so = Nothing
MsgBox("Finished!")

を、繰り返した後、最後に「Finshed!」と表示します。

2つ目です。

Option Explicit
Dim gf, n, sf, so, tx
Set so = CreateObject("Scripting.FileSystemObject")
Set gf = so.GetFolder(".")
Set tx = so.OpenTextFile(gf & "\log.txt",1, False, True)
Do Until tx.AtEndOfStream
n = Split(tx.ReadLine, vbTab)
Set sf = so.GetFolder(gf & "\" & n(1))
sf.Name = n(0)
Set sf = Nothing
Loop
tx.Close
Set tx = Nothing
Set gf = Nothing
Set so = Nothing
MsgBox("Finished!")

今度は、「log.txt」を読み込み専用で開いて、1行ずつ読み込み、フォルダ名を元にもどしています。

  • lin********さん

    2017/4/2010:14:09

    では、あくまでもご参考までに、ということになりますが、質問者のマクロに合わせて、組み込んでみてください。

    Sub Sample()
    Set so = CreateObject("Scripting.FileSystemObject")
    Set gf = so.GetFolder(ThisWorkbook.Path)
    For Each f In gf.SubFolders
    For i = 1 To Len(f.Name)
    If Asc(Mid(f.Name, i, 1)) = 63 Then
    MsgBox (f.Name)
    End If
    Next i
    Next f
    MsgBox ("Finished!")
    End Sub

    私のプログラムで、「?」がある場合の判定をしているのと同じ処理です。

    今回は、「?」が見つかったら、そのファイル名を表示しているだけです。

    これを参考に、質問者のマクロに「?」があった場合、どうするか、で組み込んでください。

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

この回答は投票によってベストアンサーに選ばれました!

ベストアンサー以外の回答

1〜2件/2件中

並び替え:回答日時の
新しい順
|古い順

e8g********さん

2017/4/1720:08:39

Dir関数の代わりに FileSystemObject を使うと文字化けせずに取得できます。


Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
Dim folder: Set folder = fso.GetFolder("C:\Data")

For Each file In folder.Files
Cells(Rows.Count, "A").End(xlUp).Offset(1).Value = file.Name
Next


CreateObject するのが面倒ですが、For Each file のように書ける部分が Dir関数よりも楽で分かりやすいと思います。

また、ファイル番号を使用する、VBA言語のオールドなファイル入出力関数もShift_JISにしか対応していません。
そちらも含めて、新たにコードを書くときは FileSystemObject を使用したほうがよいと思います。

FileSystemObject オブジェクト
https://msdn.microsoft.com/ja-jp/library/cc428071.aspx

返信を取り消しますが
よろしいですか?

  • 取り消す
  • キャンセル

みんなで作る知恵袋 悩みや疑問、なんでも気軽にきいちゃおう!

Q&Aをキーワードで検索:

Yahoo! JAPANは、回答に記載された内容の信ぴょう性、正確性を保証しておりません。
お客様自身の責任と判断で、ご利用ください。
本文はここまでです このページの先頭へ

「追加する」ボタンを押してください。

閉じる

※知恵コレクションに追加された質問は選択されたID/ニックネームのMy知恵袋で確認できます。

不適切な投稿でないことを報告しました。

閉じる