| |
▼桜 さん：
おはようございます！
遅くなってすみません。
えっと、簡単に考えると
>フォルダ名
> Aフォルダ
>ファイル名
> 1.txt
> 2.txt
↑のようなものをフォルダ名ごとに作り、
それをメールの本文にいれ一つ一つ送信したいという
感じなのでしょうか？
とりあえず最初の目的だけと考えまして。
下のサンプルコードを考えてみましたが参考になりますでしょうか。
こちらは、sheet1からsheet2に1行空白を入れ記述していく仕様です。
この[フォルダ名]と[ファイル名]をメール本文に入れていけばいけますか？
Sub test0()
Dim Dic As Object
Dim Keys As Variant
Dim i As Long
Dim j As Long
Dim buf1 As String
Dim buf2 As String
Dim buf3 As String
Dim RowCnt As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set Dic = CreateObject("Scripting.Dictionary")
Set ws1 = ThisWorkbook.Worksheets("sheet1")
Set ws2 = ThisWorkbook.Worksheets("sheet2")
RowCnt = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row
For i = 1 To RowCnt
buf1 = ws1.Cells(i, 1).Value
buf2 = ws1.Cells(i, 2).Value
If Not Dic.Exists(buf1) Then 'キーが被らなかったら
Dic.Add buf1, buf2
Else 'キーが被ったら
buf3 = Dic.Item(buf1) & Chr(10) & buf2 'アイテムに追加
Dic.Item(buf1) = buf3 'アイテム書き換え
End If
Next
Keys = Dic.Keys
j = 0
'sheet2へ記入
For i = 0 To Dic.Count - 1
ws2.Cells(j + 2, 1).Value = Keys(i) 'フォルダ名記入
ws2.Cells(j + 3, 1).Value = Dic.Item(Keys(i)) 'ファイル名記入
j = j + 3
Next
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
