| |
早速のご回答誠にありがとうございます、かみちゃん様。
実際にプログラムを実行させましたら、質問事項2はうまく実行することができました。
質問事項1の年月日のスペースと曜日を抜いた出力がうまくいきませんでした。
先に記載しました実際のメールデータの内容ですが、修正させていただきます。
＜本文内容＞
お名前：田中次郎
年月日：23 年 11 月 17 日 水 曜日
利用開始時刻：8：00
利用終了時刻：9：00
ご利用区分：現金
交通手段：車
ご利用場所：大阪難波店
店員名：木村二郎
店の雰囲気：3
店のサービス：4
状況1：これはテストです２。
これもテストです２。
状況2：あれはテストです２。
あれもテストです２。
その他ご意見：それはテストです２。
それもテストです２。
あいうえおかきくけこさしすせそたちつてと
なにぬねのはひふへほ
上記の内容で、
利用開始時刻：8：00
利用終了時刻：9：00
ご利用区分：現金
交通手段：車
ご利用場所：大阪難波店
の項目が増えていますが、これら5つの項目はエクセルには出力いたしません。
この内容で修正していただいたプログラムを実行いたしましたら
セルC2、C3、C4…に「ご利用場所」の内容が出力されてしまい、「年月日」の内容が出力されませんでした。
また、
Case "状況1"
lngCellColumnNumber = 10
Case "状況2"
lngCellColumnNumber = 11
の部分ですが、状況2の内容を状況1と同じセルに出力するにはどうしたらいいでしょうか？
Case "状況1"
lngCellColumnNumber = 10
Case "状況2"
lngCellColumnNumber = 10
では、状況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 Sample2()
>
> 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
>
> Dim strKoumoku As String, ss As String
> Dim lngCellColumnNumber As Long
>
> 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
>
> strKoumoku = "": ss = ""
> For lngTextLineNumber = 0 To UBound(LineContents)
> DivideCharPosition = InStr(LineContents(lngTextLineNumber), DivideChar)
> '区切り文字が存在するか、項目名が取得できている場合処理する
> If strKoumoku <> "" Or DivideCharPosition <> 0 Then
> '区切り文字が存在する場合、項目名を取得する
> If DivideCharPosition <> 0 Then
> strKoumoku = Left(LineContents(lngTextLineNumber), DivideCharPosition - 1)
> Select Case strKoumoku
> Case "お名前"
> lngCellColumnNumber = 1
> Case "年月日"
> lngCellColumnNumber = 3
> Case "店員名"
> lngCellColumnNumber = 5
> Case "店の雰囲気"
> lngCellColumnNumber = 6
> Case "店のサービス"
> lngCellColumnNumber = 8
> Case "状況1"
> lngCellColumnNumber = 10
> Case "状況2"
> lngCellColumnNumber = 11
> Case "その他ご意見"
> lngCellColumnNumber = 12
> End Select
> End If
> '項目名が取得できている場合処理する
> If strKoumoku <> "" Then
> With Cells(lngCellLineNumber, lngCellColumnNumber)
> If DivideCharPosition <> 0 Then
> ss = Mid(LineContents(lngTextLineNumber), DivideCharPosition + 1)
> If strKoumoku = "年月日" Then
> ss = Replace(ss, " ", "")
> ss = Mid(ss, 1, InStr(ss, "日"))
> End If
> .Value = ss
> Else
> .Value = .Value & LineContents(lngTextLineNumber)
> End If
> End With
> End If
>
> End If
>
> Next lngTextLineNumber
>
> ts.Close
> Set ts = Nothing
>
> Next File
>
> Set FSO = Nothing
>
>End Sub
|
|
poosuke
- 10/9/9(木) 15:31 -
