VBAを使用し取得したフォルダ内のテキストデータも文字数と半角文字の有無を抽出したい。

指定フォルダからファイル名一覧を書き出し
1.B3セルにテキスト名が記載される。（例：sample）
2.C3セルにファイルの種類が表示される（例：TXT ファイル）
の簡単なソースはできたのですが、

3.D3セルにB3のセルのテキストデータ内の全文字数をカウント（数字のみ記載）
4.E3セルにB3で取得した文字数の中に半角の文字が入っているかを確認（入っていたら、１など）

というVBAのファイルを作成したいのですが3.と4.の作成方法がわかりません。

また現在までで出来ているのは、下記のソースまでです。
（初心者のため間違えているところがあるかもしれません）
お教えいただけませんでしょうか。よろしくお願いいたします。

Sub MakeFileList()

Target = InputBox("ディレクトリ名を入力", "ディレクトリの指定", "C:\Windows")

Set FS = CreateObject("Scripting.FileSystemObject")
Set Fol = FS.GetFolder(Target)
Set Fil = Fol.Files
ThisWorkbook.Sheets("Sheet1").UsedRange.Delete

'見出しを付ける
ThisWorkbook.Sheets(1).Range("B2") = "ファイル名"
ThisWorkbook.Sheets(1).Range("C2") = "ファイル種別"
ThisWorkbook.Sheets(1).Range("D2") = "文字数"
ThisWorkbook.Sheets(1).Range("E2") = "半角の有無"
ThisWorkbook.Sheets(1).Range("B2:E2").Interior.Color = RGB(0, 0, 0)
ThisWorkbook.Sheets(1).Range("B2:E2").Font.Color = RGB(255, 255, 255)
ThisWorkbook.Sheets(1).Range("B2:Es2").HorizontalAlignment = xlCenter

i = 3
For Each Fx In Fil
'ファイル名
sFile = Fx.Name
'ファイル名の書き出し
ThisWorkbook.Sheets(1).Cells(i, 2) = sFile
'ファイル種別
sFType = Fx.Type
ThisWorkbook.Sheets(1).Cells(i, 3) = sFType
i = i + 1
Next
End Sub

質問者からの補足コメント

• 

  VBAを使用し取得したフォルダ内のテキストデータ「から」文字数と半角文字の有無を抽出したい。
  の間違いです。申し訳ございません。

    補足日時：2017/02/01 11:04

No.2 ベストアンサー 回答者： WindFaller 回答日時： 2017/02/01 15:21

なるべく元のコードに似せて作ってみました。

Microsoft の"Hey Scripting Guy" の解説に半角を数える話があったのですが、半角とか調べるには、Wordオブジェクトを使うのだなんて書かれていました。簡単に思う人もいますが、Wordでは、特殊な技なくしては数えてくれないのです。

あまりはっきり記憶がないけれども、
If LenB(StrConv(sText, vbFromUnicode)) <> Len(sText) *2
で、半角が分かるはずです。ただし、今現在は、半角空白などは考慮に入れていません。

なお。巨大なファイルは試していません。

'//
Sub MakeFileLis2()
　Dim objFS As Object
　Dim objFolder As Object
　Dim objText As Object
　Dim sText As String
　Dim Target As String
　Dim mFolder
　Dim mFiles
　Dim f As Variant, sFile As String, sFType As String
　Dim i As Long
　Dim mPath As String: mPath = CreateObject("WScript.Shell").SpecialFolders.Item(16) 'Documents
　'****セッテング*****
　'見出しを付ける
　ThisWorkbook.Activate
　With Worksheets(1)
　　.UsedRange.Clear
　　.Range("B2:E2").Value = Array("ファイル名", "ファイル種別", "文字数", "半角の有無")
　　.Range("B2:E2").Interior.ColorIndex = xlColorIndexNone
　　.Range("B2:E2").Font.ColorIndex = xlColorIndexNone
　　.Range("B2:E2").HorizontalAlignment = xlCenter
　　
　　'****実行*****
　　Application.SendKeys "{right}"
　　Target = InputBox("ディレクトリ名を入力", "ディレクトリの指定", "C:\Windows")
　　'Target = InputBox("ディレクトリ名を入力", "ディレクトリの指定", mPath) こちらは''myDocument になります。
　　If StrPtr(Target) = 0 Then Exit Sub 'ESCを押した場合
　　If Right(Target, 1) <> "\" Then Target = Target & "\"
　　If Dir(Target, vbDirectory) = "" Then
　　　MsgBox Target & "は存在していません。", vbExclamation
　　　Exit Sub
　　End If
　　Set objFS = CreateObject("Scripting.FileSystemObject")
　　Set mFolder = objFS.GetFolder(Target)
　　Set mFiles = mFolder.Files
　　i = 3
　　Application.ScreenUpdating = False
　　'*****ループのスタート*****
　　For Each f In mFiles
　　 If InStr(f.Type, "テキスト") > 0 Then 'テキストのみにする
　　　'ファイル名
　　　sFile = f.Name
　　　'ファイル名の書き出し
　　　.Cells(i, 2).Value = sFile
　　　'ファイル種別
　　　
　　　.Cells(i, 3).Value = f.Type
　　　Set objText = objFS.OpenTextFile(Target & sFile, 1)　'For-Reading
　　　sText = objText.ReadAll
　　　sText = Replace(sText, vbCrLf, "")　'改行コードは数えない
　　　.Cells(i, 4).Value = Len(sText)
　　　 If LenB(StrConv(sText, vbFromUnicode)) <> Len(sText) * 2 Then
　　　　　.Cells(i, 5).Value = 1
　　　 Else
　　　　　.Cells(i, 5).Value = 0
　　　 End If
　　　objText.Close
　　　i = i + 1
　　 '' If i > 50 Then Exit For　　'限界を設けることが可能
　　　End If
　　Next
　　Application.ScreenUpdating = True
　　
　　MsgBox "終了", vbInformation
　End With
　Set objFS = Nothing
　
End Sub

この回答へのお礼

ありがとうございます。大変勉強になります。

お礼日時：2017/02/01 15:38

No.1 回答者： WindFaller 回答日時： 2017/02/01 14:19

フォルダ内のテキストデータ「から」文字数と半角文字の有無を抽出したい。

ふつうは、数字やアルファベットは標準的に半角で、テキストファイル等には入っているものです。しかし、その半角文字というのは、数字やアルファベットなどを除いたものでしょうか。
半角カタカナとかに限るというわけではないでしょうか。

この回答へのお礼

説明不足で申し訳ございません。
すべてのテキストデータの中には、全角ひらがな・全角カタカタ・全角アルファベット・全角数字が基本のファイルなのですが、中には半角のアルファベットや、数字などが含まれており、検索するために半角文字の有無を調べたいと考えております。知恵をお貸しいただければと思います。
よろしくお願いいたします。

お礼日時：2017/02/01 14:29