| |
いつもお世話になっています。
今回も自分なりに試行錯誤してみたのですが、エラーを回避できなかったので、お力をお借りしたく、投稿しました。
"TEST"フォルダ内に"1234_ABCD"の形式のフォルダが複数格納されている。
"1234_ABCD"フォルダ内に、"1234.txt"ファイルが格納されている。
マクロ1で、フォルダ名を"_"で区切った"1234"と"ABCD"に分けてA列とB列に入力
TESTフォルダ内に、"AAA.TXT"のダミーテキストファイルを作っておき、
これを選択すると、フォルダ名を"_"で区切ってエクセルに入力できるように
マクロを作成しました。（正常に動作します）
マクロ2で、1234.txt内の文字列を検索し、該当する文字列をC列とD列に入力
対象の"1234.txt"を直接選択すれば、検索結果をエクセルに取り込める
正常に動作しています。
マクロ1、マクロ2は、それぞれ単独では動作するのですが、１回のマクロにしたいのです。
そこで、下記マクロを作成したのですが、
Set fnow = fso.OpenTextFile(FPa, ForReading)
で、”実行時エラー 5 プロシージャの呼び出し、または引数が不正です”
エラーが出てしまいます。
恐らく"FP"の設定がおかしいのではないかと思うのですが、どなたかアドバイスをお願い致します。
作成マクロ
Private Function GetWriteFile(vntFileName As Variant, _
Optional strFilePath As String) As Boolean
Dim strFilter As String
Dim strInitialFile As String
strFilter = "全て (*.*),*.*"
strInitialFile = vntFileName
If strFilePath <> "" Then
ChDrive Left(strFilePath, 1)
ChDir strFilePath
End If
vntFileName _
= Application.GetSaveAsFilename(vntFileName, strFilter, 1)
If vntFileName = False Then
Exit Function
End If
GetWriteFile = True
End Function
Sub Folder()
Dim fso As Object, fnow As Object
Dim MyPath As String, folpath As String, folmei As String, fmei As String
Dim fbasename As String, kaku As String, strPath As String
Dim vntFileName As Variant, Name As Variant, FP As Variant
Dim DataJ As Range
Dim i, j
Set fso = CreateObject("Scripting.FileSystemObject")
i = Worksheets("LIST").Range("A65536").End(xlUp).Row
If GetWriteFile(vntFileName, strPath) Then
MyPath = vntFileName 'ファイルのフルパス
folpath = fso.getparentfoldername(MyPath) & "\" 'フォルダのパス
folmei = fso.getfolder(folpath).Name 'フォルダ名
fmei = FSO.getfile(MyPath).Name 'ファイル名
fbasename = FSO.getbasename(MyPath)'ファイル名から拡張子を除いた部分
kaku = FSO.GetExtensionName(MyPath) '拡張子
MyName = Dir(folpath, vbDirectory) '最初のフォルダ名を返します。
Worksheets("TEMP").Range("A1").Value = folpath
Do While MyName <> "" ' ループを開始します。
'現在のフォルダと親フォルダは無視します。
If MyName <> "." And MyName <> ".." Then
'ビット単位の比較を行い、MyName がフォルダかどうかを調べます。
If (GetAttr(folpath & MyName) And vbDirectory) = vbDirectory Then
'フォルダであれば、それを表示します。
i = i + 1
FName = Split(MyName, "_")
Worksheets("LIST").Cells(i, 1).Value = FName(0)
Worksheets("LIST").Cells(i, 2).Value = FName(1)
End If
End If
MyName = Dir ' 次のフォルダ名を返します。
Loop
End If
With Worksheets("LIST")
j = .Range("A65536").End(xlUp).Row
For k = 2 To j
.Cells(k, 5).Value = Worksheets("TEMP").Range("A1").Value & .Range("A" & k).Value & _
"_" & .Range("B" & k).Value & "\" & .Range("A" & k).Value & ".xml"
FP = folpath & FName(0) & "_" & FName(1) & "\" & FName(0) & ".txt"
Sheets("LIST").Cells(k, 7) = FPa
Set fso = CreateObject("Scripting.FileSystemObject")
Set fnow = fso.OpenTextFile(FPa, ForReading)
Do While fnow.AtEndOfStream <> True
temp = fnow.readline
If temp Like "*<name>*" Then
TANTO = Split(Replace(temp, "<", ">"), ">")
Sheets("LIST").Cells(k, 6) = TANTO(1)
ElseIf temp Like "*<element id=*" Then
BLID = Split(temp, """")
BLID1 = BLID(1)
Sheets("LIST").Cells(k, 7 + BLID1 * 2) = BLID1
ElseIf temp Like "*<machine_type>*" Then
BLDX = Split(Replace(temp, ">", "<"), "<")
Sheets("LIST1").Cells(k, 8 + BLID1 * 2) = BLDX(2)
End If
Loop
fnow.Close
Set fnow = Nothing
Next
End With
End Sub
|
|
たかし
- 09/3/16(月) 9:56 -
