| |
題名についてご質問させていただきます。具体的な質問事項は最後に記載しております。
複数のアンケートのようなメールデータを取り込み、項目ごとに「：」以下の内容をエクセルに出力するプログラムをVBAで作りました。
「：」より前の項目はヘッダーとしてあらかじめエクセルに記入しておきます。
取り込むメールデータは「eml」というフォルダにドラッグ＆ドロップで保存しておきます。
実際のメールデータの本文内容は下記となります。
お名前：田中次郎
年月日：23 年 11 月 17 日 水 曜日
店員名：木村二郎
店の雰囲気：3
店のサービス：4
状況1：これはテストです２。
これもテストです２。
状況2：あれはテストです２。
あれもテストです２。
その他ご意見：それはテストです２。
それもテストです２。
あいうえおかきくけこさしすせそたちつてと
なにぬねのはひふへほ
＜プログラム＞
Option Explicit
Public Const adTypeText = 2
Public Const adReadLine = -2
Public Const adReadAll = -1
Public Const CONST_CHARSET = "iso-2022-jp"
Public Const CONST_MAIL_FOLDER_NAME = "eml"
Public Const DivideChar = "："
Public Const HeaderLine = 1
Sub Sample()
Dim ts As Object ''テキストストリーム
Dim lngTextLineNumber As Long, lngCellLineNumber As Long
Dim ファイルパス As String, TextContents As String, LineContents() As String
Dim DivideCharPosition As Long
Dim FSO As Object
Dim TextFile As Object
Dim File As Object
Dim FolderPosition As String
Set FSO = CreateObject("Scripting.FileSystemObject")
lngCellLineNumber = HeaderLine
FolderPosition = ThisWorkbook.Path & "\" & CONST_MAIL_FOLDER_NAME
For Each File In FSO.GetFolder(FolderPosition).Files
'ファイルをオープンする。（読み取り専用）
Set ts = CreateObject("ADODB.Stream")
'オブジェクトに保存するデータの種類を文字列型に指定する
ts.Type = adTypeText
'文字列型のオブジェクトの文字コードを指定する
ts.Charset = CONST_CHARSET
'オブジェクトのインスタンスを作成
ts.Open
'ファイルからデータを読み込む
ts.LoadFromFile (File.Path)
TextContents = ts.ReadText(adReadAll)
LineContents = Split(TextContents, vbCrLf)
lngCellLineNumber = lngCellLineNumber + 1
For lngTextLineNumber = 0 To UBound(LineContents)
DivideCharPosition = InStr(LineContents(lngTextLineNumber), DivideChar)
If DivideCharPosition <> 0 Then
Select Case Left(LineContents(lngTextLineNumber), DivideCharPosition - 1)
Case "お名前"
Cells(lngCellLineNumber, 1).Value = Mid(LineContents(lngTextLineNumber), DivideCharPosition + 1)
Case "年月日"
Cells(lngCellLineNumber, 3).Value = Mid(LineContents(lngTextLineNumber), DivideCharPosition + 1)
Case "店員名"
Cells(lngCellLineNumber, 5).Value = Mid(LineContents(lngTextLineNumber), DivideCharPosition + 1)
Case "店の雰囲気"
Cells(lngCellLineNumber, 6).Value = Mid(LineContents(lngTextLineNumber), DivideCharPosition + 1)
Case "店のサービス"
Cells(lngCellLineNumber, 8).Value = Mid(LineContents(lngTextLineNumber), DivideCharPosition + 1)
Case "状況1"
Cells(lngCellLineNumber, 10).Value = Mid(LineContents(lngTextLineNumber), DivideCharPosition + 1)
Case "状況2"
Cells(lngCellLineNumber, 11).Value = Mid(LineContents(lngTextLineNumber), DivideCharPosition + 1)
Case "その他ご意見"
Cells(lngCellLineNumber, 12).Value = Mid(LineContents(lngTextLineNumber), DivideCharPosition + 1)
End Select
End If
Next lngTextLineNumber
ts.Close
Set ts = Nothing
Next File
Set FSO = Nothing
End Sub
＜質問事項＞
1.年月日を出力する際、スペースが入った「23 年 11 月 17 日 水 曜日」ではなく、スペースと曜日を抜いた「23年11月17日」と出力させたい。
2.状況1、状況2やその他意見の項目で、本文内容に改行が入った場合、改行以下の内容が出力されないのを改行を無視して一行で出力するようにしたい。
3.状況1と状況2の内容を今は別々のセルに出力するが、それを一つのセルにまとめて出力するようにしたい。
これらを実現するには、どうプログラムを修正すればよろしいでしょうか？
具体的にプログラムを書きなおしていただけると有り難いです。
説明が長々となりややこしいと思いますが、ご助力の方お願いいたします。
|
|
poosuke
- 10/9/9(木) 11:47 -
