Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


43 / 12975 ツリー ←次へ | 前へ→

【78796】VBAに行き詰りました。助けてください。 りり 17/2/2(木) 14:52 質問[未読]

【78804】Re:VBAに行き詰りました。助けてください。 β 17/2/4(土) 0:42 発言[未読]
【78805】Re:VBAに行き詰りました。助けてください。 りり 17/2/4(土) 14:27 お礼[未読]

【78804】Re:VBAに行き詰りました。助けてください...
発言  β  - 17/2/4(土) 0:42 -

引用なし
パスワード
   ▼りり さん:

とりあえず書いてみました。

Sub Sample()
  Dim fso As Object
  Dim txt As Object
  Dim buf As String
  Dim fle As Object
  Dim i As Long
  Dim fPath As String
  Dim ext As String
  Dim shT As Worksheet
  
  With Application.FileDialog(msoFileDialogFolderPicker)
    If Not .Show Then Exit Sub 'キャンセルボタン
    fPath = .SelectedItems(1)  '選択されたフォルダパス文字列
  End With
  
  Application.ScreenUpdating = False '画面の更新を抑止する
  
  Set fso = CreateObject("Scripting.FileSystemObject")
  
  Set shT = ThisWorkbook.Sheets("Sheet1")
  
  shT.UsedRange.ClearContents
    
  With shT.Range("B2:E2")  '見出しを付ける
    .Value = Array("ファイル名", "ファイル種別", "文字数", "半角の有無")
    .Interior.Color = vbBlack
    .Font.Color = vbWhite
    .HorizontalAlignment = xlCenter  'セルの中の文を中央揃えにする
  End With
  
  i = 3  '記入示開始行
  
  For Each fle In fso.GetFolder(fPath).Files '指定フォルダ内のファイルを抽出
    ext = fso.GetExtensionName(fle.Name)  '拡張子
    If LCase(ext) = "txt" Then  'txtファイルのみを対象
      With fso.OpenTextFile(Filename:=fle.Path, IOMode:=1) '1:ForReading
        buf = .ReadAll '全体を一括読みこみ
        buf = Replace(Replace(buf, vbLf, ""), vbCr, "") '改行コードを削除
        shT.Cells(i, "B").Value = fso.GetBaseName(fle.Name)   '拡張子を除いたファイル名
        shT.Cells(i, "C").Value = ext
        shT.Cells(i, "D").Value = Len(buf)
        shT.Cells(i, "E").Value = IIf(Len(buf) * 2 <> LenB(StrConv(buf, vbFromUnicode)), "有", "無")
        .Close     'テキストファイルを閉じる
        i = i + 1    '次の記入行
      End With
    End If
  Next
    
End Sub

【78805】Re:VBAに行き詰りました。助けてください...
お礼  りり  - 17/2/4(土) 14:27 -

引用なし
パスワード
   β様
返事とお礼が遅くなり申し訳ございません。
・β様の作成されたものと私のもので何が変わったのか
・まだわからないコードの意味を1つ1つ調べる
・どういう流れで動いていくのか
を1つ1つ確認し、調べて、勉強致しておりました。

本当にありがとうございます。
今後、より勉強を重ね努力致します。

43 / 12975 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free