まりふのひと

テキストファイルを読んでCSVファイルを出力するVBAのコード

VBA YK

　単純なコード。どうも 海馬にある[要素に反応する神経細胞]に電気が通らなくなっている ようだ。
で、記録に残すことに...

  1. Public Sub デイサービスCSV変換()
  2. Dim mbTitle As String
  3. Dim isEOF As Boolean
  4. Dim dsn As Long, ds2 As Long
  5. Dim outCounter As Long
  6. Dim txtFile As String, csvFile As String
  7. Dim txtData As String, str3 As String
  8. Dim strName As String, strYubin As String, strJusho As String, strTel As String
  9. 　
  10. mbTitle = "デイサービスCSV変換/" & ThisWorkbook.Name
  11. txtFile = ThisWorkbook.Path & "\デイサービス.txt"
  12. csvFile = ThisWorkbook.Path & "\デーサービス.csv"
  13. dsn = FreeFile
  14. Open txtFile For Input As #dsn
  15. ds2 = FreeFile
  16. Open csvFile For Output As #ds2
  17. Write #ds2, "名前", "郵便番号", "住所", "電話番号"
  18. outCounter = 0
  19. Do
  20. GoSub ReadTextFile
  21. If isEOF Then Exit Do
  22. 　
  23. str3 = Left(txtData, 3)
  24. Select Case str3
  25. Case "デイサ"
  26. strName = ""
  27. Case "住所："
  28. txtData = Trim(Mid(txtData, 4))
  29. strYubin = Trim(Left(txtData, 8))
  30. strJusho = Trim(Mid(txtData, 9))
  31. Case "電話："
  32. strTel = Trim(Mid(txtData, 4))
  33. Case "運営事"
  34. If strName <> "" Then
  35. Write #ds2, strName, strYubin, strJusho, strTel
  36. outCounter = outCounter + 1
  37. strName = ""
  38. End If
  39. Case Else
  40. strName = strName & txtData
  41. End Select
  42. Loop
  43. Close dsn, ds2
  44. MsgBox outCounter & " 件の CSVファイル を作成しました。" _
  45. , vbInformation, mbTitle
  46. 　
  47. Application.Quit
  48. ThisWorkbook.Close
  49. 　
  50. Exit_デイサービス変換:
  51. Exit Sub
  52. 　
  53. ReadTextFile:
  54. isEOF = False
  55. Do
  56. If EOF(dsn) Then isEOF = True: Return
  57. Line Input #dsn, txtData
  58. If Not (txtData = "" Or txtData = ".") Then Return
  59. Loop
  60. 　
  61. End Sub


　GoSub を使っており格好悪いが、使い捨てなので...