Excel VBA質問箱 IV

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

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


15658 / 76734 ←次へ | 前へ→

【66551】Re:【VBA】メールデータをエクセルに出力するプログラムの修正の依頼
質問  poosuke  - 10/9/9(木) 15:31 -

引用なし
パスワード
   早速のご回答誠にありがとうございます、かみちゃん様。

実際にプログラムを実行させましたら、質問事項2はうまく実行することができました。

質問事項1の年月日のスペースと曜日を抜いた出力がうまくいきませんでした。
先に記載しました実際のメールデータの内容ですが、修正させていただきます。

<本文内容>
お名前:田中次郎
年月日:23 年 11 月 17 日 水 曜日
利用開始時刻:8:00
利用終了時刻:9:00
ご利用区分:現金
交通手段:車
ご利用場所:大阪難波店
店員名:木村二郎
店の雰囲気:3
店のサービス:4
状況1:これはテストです2。
これもテストです2。
状況2:あれはテストです2。
あれもテストです2。
その他ご意見:それはテストです2。
それもテストです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
2 hits

【66547】【VBA】メールデータをエクセルに出力するプログラムの修正の依頼 poosuke 10/9/9(木) 11:47 質問
【66548】Re:【VBA】メールデータをエクセルに出力す... かみちゃん 10/9/9(木) 13:00 発言
【66549】Re:【VBA】メールデータをエクセルに出力す... かみちゃん 10/9/9(木) 13:12 発言
【66551】Re:【VBA】メールデータをエクセルに出力す... poosuke 10/9/9(木) 15:31 質問
【66552】Re:【VBA】メールデータをエクセルに出力す... かみちゃん 10/9/9(木) 16:27 発言
【66556】Re:【VBA】メールデータをエクセルに出力す... poosuke 10/9/10(金) 9:08 お礼

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