【エクセルVBA】デスクトップのファイルを読み込む。誰のデスクトップでもOK。ファイル名も一部あっていればワイルドカードで特定。

こんばんは！
今日は、下記の２点を解決するマクロです。
・デスクトップにおいたCSVファイルを読み込む。
　それも、自分のデスクトップだけでなく、誰のデスクトップでもOKです。
　配布した人の自分のデスクトップにおいたCSVファイルを読み込むことができます。
・ファイル名にワイルドカード
　例えば、基幹業務システムから出力したCSVファイルの名前が、
　出力の日時によって変化したりするケースがあります。
　今日は、売上0217というファイル名だけど、明日だと売上0218とか。
　それを、売上以降が変化しても、自動で読み込むことができます。

PathA = Dir(Dpath & “￥” & “売上*.csv”)←ここの売上の部分の名称をファイルネームに変更します。

例えば、管理0217.CSVとか管理0218.CSVの場合は、管理　という文字にします。

Sub DesktopPath()

'デスクトップのパスを取得  wshに使用者のデスクトップのパスが入ります。
  Dim wsh As Object
  Dim Dpath As String 'デスクトップのパスを入れる変数
  Set wsh = CreateObject("WScript.Shell")
  Dpath = wsh.SpecialFolders("Desktop") '変数に代入
  Set wsh = Nothing 'オブジェクト解放


Dim PathA As String 'ファイルパス格納変数宣言
Dim PathB As String
 
  PathA = Dir(Dpath &amp; "\" &amp; "売上*.csv") 'ここの売上の部分をファイルネームにする。
  PathB = Dpath &amp; "\" &amp; PathA
 
  Dim strFilePath As String  '読み込むファイルのパス
  strFilePath = PathB
 
 
  ' 読み込み用のシートを追加
 Dim wsImport As Worksheet
 Worksheets.Add.Name = "yomikomi"
 Set wsImport = Worksheets("yomikomi") 'CSVデータを取り込み用シート
 
  Dim queryTb As QueryTable
 
  Set queryTb = wsImport.QueryTables.Add(Connection:="TEXT;" &amp; strFilePath, _
                                         Destination:=wsImport.Range("A1")) ' CSV を開く
  With queryTb

      .TextFilePlatform = 932          ' 文字コードを指定
      .TextFileParseType = xlDelimited ' 区切り文字の形式
      .TextFileCommaDelimiter = True   ' カンマ区切り
      .RefreshStyle = xlOverwriteCells ' セルに書き込む方式
      .Refresh                         ' データを表
      .Delete                          ' CSVファイルとの接続を解除
  End With
 
End Sub

Sub DesktopPath()

'デスクトップのパスを取得 wshに使用者のデスクトップのパスが入ります。

Dim wsh As Object

Dim Dpath As String 'デスクトップのパスを入れる変数

Set wsh = CreateObject("WScript.Shell")

Dpath = wsh.SpecialFolders("Desktop") '変数に代入

Set wsh = Nothing 'オブジェクト解放

Dim PathA As String 'ファイルパス格納変数宣言

Dim PathB As String

PathA = Dir(Dpath & "\" & "売上*.csv") 'ここの売上の部分をファイルネームにする。

PathB = Dpath & "\" & PathA

Dim strFilePath As String '読み込むファイルのパス

strFilePath = PathB

' 読み込み用のシートを追加

Dim wsImport As Worksheet

Worksheets.Add.Name = "yomikomi"

Set wsImport = Worksheets("yomikomi") 'CSVデータを取り込み用シート

Dim queryTb As QueryTable

Set queryTb = wsImport.QueryTables.Add(Connection:="TEXT;" & strFilePath, _

Destination:=wsImport.Range("A1")) ' CSV を開く

With queryTb

.TextFilePlatform = 932 ' 文字コードを指定

.TextFileParseType = xlDelimited ' 区切り文字の形式

.TextFileCommaDelimiter = True ' カンマ区切り

.RefreshStyle = xlOverwriteCells ' セルに書き込む方式

.Refresh ' データを表

.Delete ' CSVファイルとの接続を解除

End With

End Sub

↓よろしければクリックお願いします🌼
にほんブログ村