Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


3670 / 13644 ツリー ←次へ | 前へ→

【60799】フォルダ名とテキストファイルの読み込み たかし 09/3/16(月) 9:56 質問[未読]
【60800】Re:フォルダ名とテキストファイルの読み込み neptune 09/3/16(月) 10:26 発言[未読]
【60801】Re:フォルダ名とテキストファイルの読み込み たかし 09/3/16(月) 10:47 質問[未読]
【60802】Re:フォルダ名とテキストファイルの読み込み たかし 09/3/16(月) 11:01 お礼[未読]

【60799】フォルダ名とテキストファイルの読み込み
質問  たかし  - 09/3/16(月) 9:56 -

引用なし
パスワード
   いつもお世話になっています。
今回も自分なりに試行錯誤してみたのですが、エラーを回避できなかったので、お力をお借りしたく、投稿しました。

"TEST"フォルダ内に"1234_ABCD"の形式のフォルダが複数格納されている。
"1234_ABCD"フォルダ内に、"1234.txt"ファイルが格納されている。

マクロ1で、フォルダ名を"_"で区切った"1234"と"ABCD"に分けてA列とB列に入力
 TESTフォルダ内に、"AAA.TXT"のダミーテキストファイルを作っておき、
 これを選択すると、フォルダ名を"_"で区切ってエクセルに入力できるように
 マクロを作成しました。(正常に動作します)
マクロ2で、1234.txt内の文字列を検索し、該当する文字列をC列とD列に入力
 対象の"1234.txt"を直接選択すれば、検索結果をエクセルに取り込める
 正常に動作しています。

マクロ1、マクロ2は、それぞれ単独では動作するのですが、1回のマクロにしたいのです。
そこで、下記マクロを作成したのですが、
  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

【60800】Re:フォルダ名とテキストファイルの読み...
発言  neptune  - 09/3/16(月) 10:26 -

引用なし
パスワード
   ▼たかし さん:
こんにちは

>恐らく"FP"の設定がおかしいのではないかと思うのですが、どなたかアドバイスをお願い致します。

ソースは読んでませんが、IEの検索機能でFPaで検索すると
おかしいも何も、UPされたソースでは変数FPaは宣言もされてないし、
又、FPaに対して何も代入されて無いようですが?
この辺りはどうなってます?

このような事は開発環境ののブレークポイント、ローカルウィンドウ、
イミディエイトウィンドウ、ウォッチウィンドウなどで簡単に
確認できます。それらのデバッグツールの使い方を覚える事を
お勧めします。

【60801】Re:フォルダ名とテキストファイルの読み...
質問  たかし  - 09/3/16(月) 10:47 -

引用なし
パスワード
   ▼neptune さん:
すみません。いろいろと試していた時の戻し忘れです。
"Set fnow = fso.OpenTextFile(FP, ForReading)"としてもエラーは同じです。

テキストファイルを直接読む場合には、

Sub CMDEXE(inputmode As Integer)
  Dim FP As Variant
  Dim fso As Object, fnow As Object
  Dim temp As Variant, BLID As Variant, BLDX As Variant, BLDY As Variant, BLID1 As Long
  Dim GetD As Date
  Dim i As Integer, j
  Dim rowcount

  Const ForReading = 1, ForWriting = 2, ForAppending = 8
  FP = Application.GetOpenFilename(MultiSelect:=True, _
      Title:=" xlm File を選択して下さい")
    If Not IsArray(FP) Then
      MsgBox ("処理を中止します")
      Exit Sub
    End If

  Set fso = CreateObject("Scripting.FileSystemObject")

  DoEvents

   rowcount = Sheets("LIST").Range("C65536").End(xlUp).Row + 1
  
  For i = 1 To UBound(FP)
    Set fnow = fso.OpenTextFile(FP(i), ForReading)
    Do While fnow.AtEndOfStream <> True
      temp = fnow.readline
      
      GetD = fso.getfile(FP(i)).DateLastModified
      FN = fso.getfilename(FP(i))
      
       If temp Like "*<name>*" Then
        TANTO = Split(Replace(temp, "<", ">"), ">")
        Worksheets("LIST").Cells(rowcount, 4) = TANTO(2)
       ElseIf temp Like "*<element id=*" Then
        BLID = Split(temp, """")
        BLID1 = BLID(1)
        Worksheets("LIST").Cells(1, 7 + BLID1) = BLID1
       ElseIf temp Like "*<machine_type>*" Then
        BLDX = Split(Replace(temp, ">", "<"), "<")
        Worksheets("LIST").Cells(rowcount, 7 + BLID1) = BLDX(2)
       End If
    Loop
    fnow.Close
    Set fnow = Nothing
   DoEvents
  Next i
End Sub

で、正常に読み込めます。
”ファイルを開く”で得られる"FP"の設定が間違っているのではないかと思っています。

【60802】Re:フォルダ名とテキストファイルの読み...
お礼  たかし  - 09/3/16(月) 11:01 -

引用なし
パスワード
   ▼neptune さん:
Sub Folder()のマクロに、
 "Const ForReading = 1, ForWriting = 2, ForAppending = 8"
を入れるのを忘れていました。
何とかできそうなので、自分でがんばってみます。
また躓いたときには、相談させてください。

>このような事は開発環境ののブレークポイント、ローカルウィンドウ、
>イミディエイトウィンドウ、ウォッチウィンドウなどで簡単に
>確認できます。それらのデバッグツールの使い方を覚える事を
>お勧めします。

これらの存在を知りませんでした。今後活用できるように、勉強します。
ありがとうございました。

3670 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free