[[20211222153935]]　『Excelマクロで更新日時最新のテキストファイルを氏x（まーちゅん）　ページの最後に飛ぶ

『Excelマクロで更新日時最新のテキストファイルを取り込みたい』（まーちゅん）

Excelマクロで[ダウンロード]フォルダ内の更新日時が最新のテキストファイルをExcelに取り込むマクロのコードはどう書けばいいですか？テキストファイルのデータは全て文字列(UTF-8)で取り込みたいです。行や列がズレないようにしたいです。よろしくお願いします。

＜使用 Excel：Excel2013、使用 OS：Windows10 ＞

 >マクロのコードはどう書けばいいですか？
 人任せではなくマクロ記録してみればどう。
（nm） 2021/12/22(水) 16:35

ダウンロードフォルダの最新ファイル探しの部分だけ。

 Sub Sample()
    Dim FilePath As String
    Dim FileName As String
    Dim NewestDate As Date
    Dim NewFileName As String
    Dim d As Date
    With CreateObject("Wscript.Shell")
        FilePath = .SpecialFolders("MyDocuments")
    End With
    FilePath = Left(FilePath, InStrRev(FilePath, "\")) & "DownLoads"
    If Dir(FilePath, vbDirectory) = "" Then Exit Sub    'DownLoadsフォルダが見つからなかったら終了

    FileName = Dir(FilePath & "\*.*")
    Do While FileName <> ""
        d = FileDateTime(FilePath & "\" & FileName)
        If d > NewestDate Then
            NewestDate = d
            NewFileName = FileName
        End If
        FileName = Dir
    Loop
    MsgBox FilePath & "\" & NewFileName & vbCrLf & NewestDate
 End Sub

続きは以下参照
http://officetanaka.net/excel/vba/file/file10.htm
（きまぐれおじさん） 2021/12/22(水) 16:52

回答ありがとうございます
早速実行してみたのですが、ダウンロードフォルダ内の更新日時が一番新しい
テキストファイルを取り込みたいのですが、今回私のダウンロードフォルダ内の最新のファイルはpdfでした
なので取り込むことはできませんでした。(メッセージにもpdfと表示されました)

他に何か新しいファイルがあってもそれは無視して
最新のテキストファイルを取り込むマクロが知りたいです

（まーちゅん） 2021/12/22(水) 17:00

また、サイトに書かれていたコードを最後のEnd Subの間に挟み込めばいいのでしょうか？
↓
Sub Sample3()

    Dim buf As String, Target As String, i As Long
    Dim tmp As Variant, j As Long
    Target = "D:\Work\UTF-8のテキスト.csv"
    With CreateObject("ADODB.Stream")
        .Charset = "UTF-8"
        .Open
        .LoadFromFile Target
        Do Until .EOS
            buf = .ReadText(-2)
            i = i + 1
            tmp = Split(buf, ",")
            For j = 0 To UBound(tmp)
                Cells(i, j + 1) = tmp(j)
            Next j
        Loop
        .Close
    End With
End Sub

不慣れですみません
（まーちゅん） 2021/12/22(水) 17:03

ご参考。

https://www.google.com/search?q=VBA+DIR+%E3%83%86%E3%82%AD%E3%82%B9%E3%83%88%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB
（ひまつぶし） 2021/12/22(水) 17:17

回答ありがとうございます！！
マクロの記録は既に試しました
その場合1つのテキストファイルを取り込むことはできるのですが
更新日時が最新のテキストファイルを取り込むということまでは
マクロの記録でどうやるか分かりません
テキストファイルの名前が変わったとしても
更新日時が最新であれば取り込むという応用が効くマクロが作りたいので
こちらでお願いしております
（ららんらん） 2021/12/22(水) 18:51

ちなみにマクロの記録で作成したコードは以下になります
これだと 7033415433018981.txtしか取り込めません
このコードだと文字列の件は解決していると思います

   With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Users\あああ\Downloads\7033415433018981.txt", Destination:= _
        Range("$A$1"))
        .Name = "7033415433018981"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 932
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, _
        2, 2, 2, 2, 2, 2, 2, 2)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

（ららんらん） 2021/12/22(水) 19:03

テキストファイルに限定して、ファイルを列挙する（次々に取得する）ことができます。

具体的には、Dir関数でワイルドカードを使うことによって可能になります。
下記のサイトを参考にして情報を取得してください。
http://officetanaka.net/excel/vba/tips/tips69.htm
（γ） 2021/12/22(水) 20:10

 Sub test()
    Dim wsh As Object
    Dim p As String
    Dim cmd As String
    Dim target As String

    Set wsh = CreateObject("wscript.shell")
    p = wsh.SpecialFolders("mydocuments") & "\..\Downloads\"
    cmd = "cmd /c dir """ & p & "*.txt"" /b/o-d"
    target = Split(wsh.exec(cmd).stdout.readall, vbCrLf)(0)
    MsgBox target

 End Sub
（マナ） 2021/12/22(水) 20:14

（まーちゅん）=（ららんらん）

二重人格?

（?） 2021/12/22(水) 20:34

 ＞ちなみにマクロの記録で作成したコードは以下になります
 ＞.TextFilePlatform = 932

操作を間違えていませんか。

（マナ） 2021/12/22(水) 20:42

マナさんありがとうございます！
1度そのコードでためしてみます
勘違いしてました、ずっとUTFと思ってましたがJISの方でした
（ららんらん） 2021/12/22(水) 22:02

 2021/12/22(水) 20:10のコメントは無視ですか？
 | 回答ありがとうございます
 | 早速実行してみたのですが、ダウンロードフォルダ内の更新日時が一番新しい
 | テキストファイルを取り込みたいのですが、今回 私のダウンロードフォルダ内の最新のファイルはpdfでした
 | なので取り込むことはできませんでした。(メッセージにもpdfと表示されました)
 ということだったので、その対応策を提示したつもりです。
 参照サイトの一番始めに書いてあるように、
     FileName = Dir(FilePath & "\*.txt")
 のようにすると改善するんですが。

（γ） 2021/12/22(水) 23:13

[[20211222170547]]　『CSV出力したものをソフトに取り込むと謎の空白行ａx（ららんらん）

同じ人
（ベム） 2021/12/23(木) 01:38

回答ありがとうございます！
（γ）の言われた通りやってみましたら、メッセージにきちんと
テキストファイルが表示されました！！
ただこれをどうやって取り込むのですか？
目的はメッセージの表示ではなく取り込むということなのです(T^T)
（ららんらん） 2021/12/23(木) 18:23

取り込み先は、どこでしょうか

（マナ） 2021/12/23(木) 18:36

Excelです！
仮としてあ.xlsmとします
このマクロを起動したExcelにテキストファイルを取り込むという感じです
（ららんらん） 2021/12/23(木) 18:43

既存のシートですか。だとしたらシート名は？セル位置は？
それとも、シートを追加する？その場合、追加したシートの名前はどうしますか？

（マナ） 2021/12/23(木) 18:49

回答者ニックネーム気にしないのかなー。

（?） 2021/12/23(木) 20:16

既存です！デフォルトのSheet1です
（らんまる） 2021/12/23(木) 20:27

セル位置はA1でお願いします！
マクロの記録の時もそれでやったやつ載せてますが
セル位置とはそのことで合ってますかね
すみませんm(*_ _)m
（ららんらん） 2021/12/23(木) 20:30

すみません、他の質問と見分けるため
ニックネーム変えてました
それが残っちゃうんですね笑

（ららんらん） 2021/12/23(木) 20:31

＞他の質問と見分けるため
＞ニックネーム変えてました

そうですか、マクロクくれくれ君がよくつかう手法ですね。
（くれくれ君？） 2021/12/23(木) 20:39

Sheet1の既存データはすべて消してしまって構わないですか。

（マナ） 2021/12/23(木) 20:41

はい！Sheet1には元々何もデータがないので問題ないです！
ある場合も消えても問題ありません
（ららんらん） 2021/12/23(木) 21:38

確認おねがいします。
エクセルの「ファイル」-「開く」から
そのテキストファイルを開くとどうなりますか。
文字化け等の問題はありますか。

（マナ） 2021/12/23(木) 21:59

もう一つ、エクスプローラーから、そのテキストファイルを選んで
エクセルに、ドラッグ＆ドロップで、どうなりますか。

（マナ） 2021/12/23(木) 22:34

返事がないようなので、これで。
処理に最低限必要なものを残して削ったので、問題なら戻してください。

 Sub test()
     Dim wsh As Object
    Dim p As String
    Dim cmd As String
    Dim src As String
    Dim dst As Worksheet

    Set wsh = CreateObject("wscript.shell")
    p = wsh.SpecialFolders("mydocuments") & "\..\Downloads\"
    cmd = "cmd /c dir """ & p & "*.txt"" /b/o-d"
    src = p & Split(wsh.exec(cmd).stdout.readall, vbCrLf)(0)

    Set dst = ThisWorkbook.Sheets("sheet1")
    dst.UsedRange.ClearContents
    With dst.QueryTables.Add( _
        Connection:="TEXT;" & src, Destination:=dst.Range("A1"))
        .TextFilePlatform = 932
        .TextFileTabDelimiter = True
        .Refresh BackgroundQuery:=False
        .Delete
    End With

 End Sub

（マナ） 2021/12/23(木) 23:51

すみません！遅れました
ファイルから開いても文字化けはありません！
コピペでも大丈夫です
ドラッグドロップでも同じはず
ただその場合は事前にセルを文字列にしないと
先頭の0が消えたりということは起きます
（ららんらん） 2021/12/24(金) 00:23

動きました！ありがとうございます！！今のところきちんと動いています
ただなぜかすべてのデータが文字列になっていないのか先頭の０が消えてしまっています
解決策はありますか？
JISになっているはずなんですけどよくわかりません
（ららんらん） 2021/12/24(金) 09:45

手抜きですが。

 Sub test2()
     Dim wsh As Object
    Dim p As String
    Dim cmd As String
    Dim src As String
    Dim dst As Worksheet
    Dim k As Long
    Dim fi(1 To 50) As Long   '★txtファイルの列数が50以下

    Set wsh = CreateObject("wscript.shell")
    p = wsh.SpecialFolders("mydocuments") & "\..\Downloads\"
    cmd = "cmd /c dir """ & p & "*.txt"" /b/o-d"
    src = p & Split(wsh.exec(cmd).stdout.readall, vbCrLf)(0)

    For k = 1 To UBound(fi)
        fi(k) = xlTextFormat
    Next

    Set dst = ThisWorkbook.Sheets("sheet1")
    dst.UsedRange.ClearContents
    With dst.QueryTables.Add( _
        Connection:="TEXT;" & src, Destination:=dst.Range("A1"))
        .TextFilePlatform = 932
        .TextFileTabDelimiter = True
        .TextFileColumnDataTypes = fi
        .Refresh BackgroundQuery:=False
        .Delete
    End With

 End Sub

（マナ） 2021/12/24(金) 17:40

マナさんありがとうございます！！！
いけました！！！めちゃくちゃ凄いです！頭良いですね！！！
本当にありがとうございます(T^T)
他の協力いただいた皆様もありがとうございました！
また何かあれば質問させてくださいm(*_ _)m
本当にありがとうございました！！！
（ららんらん） 2021/12/24(金) 18:08

コメント返信：

[ 一覧(最新更新順) ]

[[20211222153935]] 『Excelマクロで更新日時最新のテキストファイルを氏x（まーちゅん） ページの最後に飛ぶ

[[20211222153935]]　『Excelマクロで更新日時最新のテキストファイルを氏x（まーちゅん）　ページの最後に飛ぶ