Excel VBA質問箱 IV

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

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


21338 / 76738 ←次へ | 前へ→

【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"の設定が間違っているのではないかと思っています。

2 hits

【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 お礼

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