|
▼かみちゃん さん:
こんばんは。
早速、ご返信頂き有難うございます。
お教え頂いた内容で試してみて、ファイル名の取得はできたのですが、
ファイル名毎にマクロを実行することが上手くいきません。
下記のコードで試しているのですが、変数に取得したファイル名を順番に
代入するとこが、上手くいきません。また、ファイルの数は毎回異なるので
、入力されたファイル名の最終行を取得して、B4から順番に処理したいのですが
、どのようにすればいいでしょうか。
宜しくお願い致します。
---------------------------------------------------------------------
Private Sub CommandButton1_Click()
Dim endF As Range
Dim c As Range
Worksheets("P_付加").Acitibe
endF = Range("B4", Range("B4").End(xlDown)).Select
For Each c In Range("B4:endF")
MsgBox c.Value
Call P_huka
Next
End Sub
Sub P_huka()
Dim fso, tempfile, Filename
Dim fText As String
Filename = F1
Open pasF For Input As #1
Open pas1 & "\temp.txt" For Output As #2
Do While Not EOF(1)
Line Input #1, fText
tText = Replace(fText, Chr(34) & " (", "P" & Chr(34) & " (")
Print #2, tText
Loop
Close #1
Close #2
Open pas1 & "\temp.txt" For Input As #2
Open pas1 & "\temp1.txt" For Output As #3
Do While Not EOF(2)
Line Input #2, fText
tText = Replace(fText, Chr(34) & " IS", "P" & Chr(34) & " IS")
Print #3, tText
Loop
Close #2
Close #3
Set fso = CreateObject("Scripting.FileSystemObject")
tempfile = fso.GetTempName
fso.DeleteFile (pasF)
fso.DeleteFile (pas1 & "\temp.txt")
Set tempfile = fso.GetFile(pas1 & "\temp1.txt")
tempfile.Name = F1
End Sub
Function pasF() As String 'フルパス
Dim pas, F
pas = Range("B3")
F = Range("B4")
pasF = pas & "\" & F
End Function
Function F1() As String
F1 = Range("B4")
End Function
Function pas1() As String
pas1 = Range("B3")
End Function
-----------------------------------------------------------------
上記を実行すると、「オブジェクトはこのプロパティ、またはメソッドを
サポートしていません」とエラーが表示されてしまいます。
|
|