質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
85.50%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

ドキュメント

ドキュメントは、IT用語では、ソフトウェアやハードウェアに関する情報であり、意図された目的、機能性、メインテナンスを含みます。ドキュメントは、多くの様々なフォームとフォーマットに存在しますが、その目的は常に教育することにあります。

文字コード

文字コードとは、文字や記号をコンピュータ上で使用するために用いられるバイト表現を指します。

Q&A

解決済

2回答

1062閲覧

【VBA】テキストドキュメント(.txt)にある\nで改行されているものを\rによる改行に変えてExcelに転記したい

masuken

総合スコア5

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

ドキュメント

ドキュメントは、IT用語では、ソフトウェアやハードウェアに関する情報であり、意図された目的、機能性、メインテナンスを含みます。ドキュメントは、多くの様々なフォームとフォーマットに存在しますが、その目的は常に教育することにあります。

文字コード

文字コードとは、文字や記号をコンピュータ上で使用するために用いられるバイト表現を指します。

0グッド

0クリップ

投稿2021/09/15 07:12

編集2021/09/15 07:27

解決したいこと

テキストファイルにある\nで改行されているものを\rによる改行に変えたいです。

(やりたいこと)
Outlook上で指定フォルダの昨日のメール情報を全て取得し、テキストドキュメントに保存

テキストドキュメントをExcelの指定位置に貼り付け。

発生している問題・エラー

VBAで取得してきたテキストドキュメントのメール本文部分の改行が、画像のように¥n方式になっております。
結果、Excelに転記した際に1つのセルにまとめて格納されてしまいます。
理想としては、自動で各行が¥rで改行されいる状態でExcelに転記したいです。

イメージ説明
※エディターはサクラエディタ

・Outlookから取得した時点で¥rで改行されている
もしくは
・Outlookから¥nで取得してくるが、その後に作成したテキストドキュメントを操作して¥nの改行をすべて¥rに変える

といった方法があれば知りたいです。
お忙しいところ恐縮ですが、よろしくお願いいたします。

該当するソースコード

VBA

1Sub テキストファイル貼り付け() 2Application.ScreenUpdating = False '画面表示更新の一時停止 3Application.Calculation = xlCalculationManual '関数の計算の一時停止 4 5Dim dtStart As Date 6 Dim dtEnd As Date 7 Const TEXT_FILE = "C:\Users\us\Desktopテスト.txt" ' 保存するファイル名を指定 8 Dim strStart As String 9 Dim strEnd As String 10 Dim objOL As Object 11 Dim objNAMESPC As Object 12 Dim strFilter As String 13 Dim myfolders As Object 14 Dim objMail As MailItem 15 Dim colItems As Items 16 Dim objAttach As Attachment 17 Dim strAttach As String 18 Dim cnt As Long 19 20 dtStart = Date - 1 21 dtEnd = Date - 1 22 strStart = FormatDateTime(dtStart, vbShortDate) & " 00:00" 23 strEnd = FormatDateTime(dtEnd, vbShortDate) & " 23:59" 24 strFilter = "[受信日時] >= '" & strStart & _ 25 "' AND [受信日時] <= '" & strEnd & "'" 26 27 '保存したいメールフォルダを取得 28 Set objOL = CreateObject("Outlook.Application") 29 Set objNAMESPC = objOL.GetNamespace("MAPI") 30 Set myfolders = objNAMESPC.Folders("a@gmail.jp").Folders("テスト") 31 32 'メールフォルダをフィルタリング 33 Set colItems = myfolders.Items.Restrict(strFilter) 34 35 36 Open TEXT_FILE For Output As #1 37 For Each objMail In colItems 38 With objMail 39 Print #1, "差出人:" & .SenderName & vbTab 40 Print #1, "送信日時:" & vbTab & .SentOn 41 If .To <> "" Then 42 Print #1, "宛先:" & vbTab & .To 43 End If 44 If .CC <> "" Then 45 Print #1, "CC:" & vbTab & .CC 46 End If 47 Print #1, "件名:" & vbTab & .Subject 48 If .Attachments.Count > 0 Then 49 strAttach = "" 50 For Each objAttach In .Attachments 51 strAttach = strAttach & objAttach.Filename & "; " 52 Next 53 strAttach = Left(strAttach, Len(strAttach) - 2) 54 Print #1, "添付ファイル: " & vbTab & strAttach 55 End If 56 If .Importance <> olImportanceNormal And .Sensitivity <> olNormal Then 57 Print #1, "" 58 End If 59 If .Importance = olImportanceHigh Then 60 Print #1, "重要度:" & vbTab & "高" 61 End If 62 If .Importance = olImportanceHigh Then 63 Print #1, "重要度:" & vbTab & "低" 64 End If 65 If .Sensitivity = olConfidential Then 66 Print #1, "秘密度:" & vbTab & "社外秘" 67 End If 68 If .Sensitivity = olPersonal Then 69 Print #1, "秘密度:" & vbTab & "個人用" 70 End If 71 If .Sensitivity = olPrivate Then 72 Print #1, "秘密度:" & vbTab & "親展" 73 End If 74 If .Categories <> "" Then 75 Print #1, "" 76 Print #1, "分類項目:" & vbTab & .Categories 77 End If 78 Print #1, "" 79 Print #1, .Body 80 Print #1, "" 81 End With 82 Next 83 84 Close #1 85End Sub 86 87Sub テキストファイルの書き込み() 88 89Open "C:\Users\us\テスト.txt" For Input As #1 90 91Dim r As Long 92 r = 2 '2行目から書き出す 93 94 Do Until EOF(1) 95 Dim buf As String 96 Line Input #1, buf 97 98 Dim aryLine As Variant '文字列格納用配列変数 99 aryLine = Split(buf, vbTab) '読み込んだ行をタブ区切りで配列変数に格納 100 101 Dim i As Long 102 For i = LBound(aryLine) To UBound(aryLine) 103 'インデックスが0から始まるので列番号に合わせるため+23 104 Cells(r, i + 23).Value = "'" & aryLine(i) 105 Next 106 107 r = r + 1 108 109 Loop 110 111Close #1 112 113Application.ScreenUpdating = True '画面表示更新の再開 114Application.Calculation = xlCalculationAutomatic '関数の計算の再開 115End Sub 116

気になる質問をクリップする

クリップした質問は、後からいつでもMYページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

Daregada

2021/09/15 07:16

以前の質問で得られた回答を使ったコードで別の質問を書く前に、以前の質問を「解決済み」にしてください。
masuken

2021/09/15 07:30

失礼いたしました。 以前のDaregada様の回答をベストアンサーとさせていただきました。
guest

回答2

0

bufに全部入ってしまうのならSplitしてしまえばいいのでは。

Dim strLine As Variant For Each strLine In Split(buf, vbCr) aryLine = Split(strLine, vbTab) With Cells(r, 23).Resize(, UBound(aryLine)) .NumberFormatLocal = "@" .Value = aryLine End With Next

投稿2021/09/15 08:06

jinoji

総合スコア4585

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

masuken

2021/09/15 12:29

↓このような形でしょうか? そうするとテキストドキュメントの1行目だけしか取得できませんでした…。 Dim r As Long r = 2 '2行目から書き出す Dim buf As String Line Input #1, buf Dim aryLine As Variant '文字列格納用配列変数 Dim strLine As Variant For Each strLine In Split(buf, vbCr) aryLine = Split(strLine, vbTab) With Cells(r, 23).Resize(, UBound(aryLine)) .NumberFormatLocal = "@" .Value = aryLine End With Next Close #1
jinoji

2021/09/15 13:33

Do Until EOF(1) … … r = r + 1 Loop は必要です
masuken

2021/09/15 14:21

ありがとうございます。 別の方法で解決しました。 アドバイスいただき、誠にありがとうございました。
guest

0

ベストアンサー

文字列を全部変数に読み込んで、その中の\nを\rに置換すればいいかと

Office TANAKA - Excel VBA関数[Replace]

投稿2021/09/15 07:15

y_waiwai

総合スコア87719

バッドをするには、ログインかつ

こちらの条件を満たす必要があります。

masuken

2021/09/15 14:20

解決しました! ありがとうございます。
guest

あなたの回答

tips

太字

斜体

打ち消し線

見出し

引用テキストの挿入

コードの挿入

リンクの挿入

リストの挿入

番号リストの挿入

表の挿入

水平線の挿入

プレビュー

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
85.50%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問