エクセルのマクロについて教えてください。

マクロを実行して
マクロブックがある、同じフォルダ内のテキストファイルを開く事が出来るマクロを作成しましたが、
上手く実行出来ません、
解決方法を教えてください。
Sub テキストファイルを開く()
Dim cdir As String
Dim tdir As String
Dim tfi As String
Dim filenum As Integer

cdir = ThisWorkbook.Path
tfi = "########_#_再修正依頼.txt"
tdir = cdir & "\" & tfi
filenum = FreeFile

Open tdir For Input As #filenum

End Sub

上記のマクロを実行すると実行時エラー53　「ファイルが見つかりません」と出て
「Open tdir For Input As #filenum」の部分が黄色くなっております。
テキストのファイル名は物件毎に変更になる半角の英数字「８」＋「_」＋半角「１」＋「_」と
固定文字の「再修正依頼」です。
尚、作業フォルダ内にはテキストファイルが一つしか有りません。
よろしくお願いします。

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

• 

  ファイル名ですが例えば「12345678_5_再修正依頼.txt」となり前半の数字は物件毎に変更され
  後半は固定文字です。
  大変困っております。
  回答をお願いします。

    補足日時：2023/07/15 17:08

• もし
  よろしければ
  もう一つの質問の回答も教えて頂けますか？
  テキストファイルからPDFファイルに変更する質問です
  よろしくお願いします

    補足日時：2023/07/15 18:00

No.2 ベストアンサー 回答者： goomania 回答日時： 2023/07/16 19:14

>尚、作業フォルダ内にはテキストファイルが一つしか有りません。

本当でしょうか?
だとすると、
>数字は物件毎に変更され･･･
とおっしゃっているので、物件毎にフォルダが作成され、同じマクロを記述したEXCELブックがフォルダ毎に存在することになります。一見無駄に見えますが、そのように運用されているということでよろしいのでしょうか?

テキストファイルを開いてPDF化するというのが、最終目的のようなので、とりあえず、TXTファイルを読み込んでPDFとして出力するマクロを書いてみました。

仮に、TEXTファイルを読み込んで、何らかの編集を行ってから、PDFとして出力するのであれば、「ここにテキスト編集用のコードを入れる」とコメントした部分に編集用のコードをいれてください。

仕様としては、以下のようになっています。
(1)元々のマクロブックの末尾に「PDF」という名前の新しいシートを追加
(2)PDFシートのA列に指定されたTEXTファイルを1行1セルで読込む
(3)PDFシートを全列(実際はA列のみ)が1ページに収まるよう設定
(4)TEXTファイルの名前の拡張子を.PDFに替えてPDFファイルとして同じフォルダに保存
という流れです。
また、テキストファイルは文字コードがShift-JISで作成されている場合とUTF-8で作成されている場合がありますが、コメントに従ってどちらかを活かしてください。(文字化けしない方にするということになります)

Sub txt2pdf()
Dim tDir As String
Dim tName As String
Dim pName As String
Dim fName As String
Dim fpName
Dim r As Long
Dim buf As String
Application.ScreenUpdating = False
Worksheets.Add After:=Sheets(Worksheets.Count)
ActiveSheet.Name = "PDF"
tDir = ThisWorkbook.Path
tName = "*_再修正依頼.txt"
fpName = tDir & "\" & tName
fName = Dir(fpName)
If fName = "" Then
MsgBox "該当ファイルがありません。処理を中止します。"
GoTo Label1
End If
pName = Replace(fName, ".txt", "")
pName = tDir & "\" & pName
With CreateObject("ADODB.Stream")
'.Charset = "UTF-8" 'テキストファイルの文字コードがUTF-8のときはこちらを生かし"Shift-JIS"をコメントアウト
.Charset = "Shift_JIS" 'テキストファイルの文字コードがShift-JISのときはこちらを生かし"UTF-8"をコメントアウト
.Open
.LoadFromFile fName
Do Until .EOS
buf = .ReadText(-2)
r = r + 1
Cells(r, 1) = buf
Loop
.Close
End With
'ここにテキスト編集用のコードを入れる
Dim erow As Long
Columns("A:A").AutoFit
erow = Cells(Rows.Count, 1).End(xlUp).Row
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintArea = "$A$1:$A$" & erow
.LeftMargin = Application.CentimetersToPoints(1)
.RightMargin = Application.CentimetersToPoints(1)
.TopMargin = Application.CentimetersToPoints(1)
.BottomMargin = Application.CentimetersToPoints(1)
.HeaderMargin = Application.CentimetersToPoints(0)
.FooterMargin = Application.CentimetersToPoints(0)
.CenterHorizontally = True
.Orientation = xlPortrait
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With
Application.PrintCommunication = True
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pName
MsgBox "txtファイルをPDF化しましした。"
Label1:
Application.DisplayAlerts = False
Sheets("PDF").Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

この回答へのお礼

回答ありがとうございます
早速試してみます

お礼日時：2023/07/16 19:16

No.1 回答者： tatsumaru77 回答日時： 2023/07/15 17:55

以下のようにしてください。

但し、openは成功しますが、それで終わっているので、このソースのままでは、表面上はなにも起こりません。
openの後に、読み込みの処理を追加すると理解しました。

Sub テキストファイルを開く()
Dim cdir As String
Dim tdir As String
Dim tfi As String
Dim fname As String
Dim filenum As Integer

cdir = ThisWorkbook.Path
tfi = "*_再修正依頼.txt"
tdir = cdir & "\" & tfi
fname = Dir(tdir)
If fname = "" Then
MsgBox ("該当ファイルなし")
End If
tdir = cdir & "\" & fname
filenum = FreeFile

Open tdir For Input As #filenum

End Sub

この回答へのお礼

回答ありがとうございます　
早速試してみます
後ほどご連絡させていただきます

お礼日時：2023/07/15 17:57