Dim attachment_file As String
attachment_file = “C:\Users\curio\Desktop\section#custom-section_h1_section-title.txt”
mITEM.Attachments.Add attachment_file
日本IBM出身Sub send_mail()
Dim i, j As Integer
Dim oApp
Dim myNameSpace
Dim myFolder
‘Outlookの起動
On Error Resume Next
Set oApp = GetObject(, “Outlook.Application”)
If oApp Is Nothing Then
Set oApp = CreateObject(“Outlook.Application”)
Set myNameSpace = oApp.GetNamespace(“MAPI”)
Set myFolder = myNameSpace.GetDefaultFolder(6)
myFolder.Display
End If
On Error GoTo 0
oApp.ActiveWindow.WindowState = 2
‘以下はメールの新規作成
Dim mITEM ‘As Outlook.MailItem’
Set mITEM = oApp.CreateItem(0)
mITEM.BodyFormat = 2
mITEM.Display
mITEM.Subject = Worksheets(“Sheet1”).Cells(1, “a”).Value
mITEM.To = Worksheets(“Sheet1”).Cells(4, “i”).Value
mITEM.CC = Worksheets(“Sheet1”).Cells(4, “j”).Value
‘メールのコピー
Range(“A3”).Select
Selection.Copy
‘貼り付け
mITEM.Display
With oApp.ActiveInspector
.WordEditor.Windows(1).Selection.Paste
End With
‘メールのコピー
Range(“A4”).Select
Selection.Copy
‘貼り付け
mITEM.Display
With oApp.ActiveInspector
.WordEditor.Windows(1).Selection.Paste
End With
‘メールのコピー
Range(“A5”).Select
Selection.Copy
‘貼り付け
mITEM.Display
With oApp.ActiveInspector
.WordEditor.Windows(1).Selection.Paste
End With
‘メールのコピー
Range(“A6”).Select
Selection.Copy
‘貼り付け
mITEM.Display
With oApp.ActiveInspector
.WordEditor.Windows(1).Selection.Paste
End With
‘メールのコピー
Worksheets(“Sheet1”).Range(“A7”).Select
Selection.Copy
‘貼り付け
mITEM.Display
With oApp.ActiveInspector
.WordEditor.Windows(1).Selection.Paste
End With
‘Dim waitTime As Variant
‘waitTime = Now + TimeValue(“0:00:2”)
‘Application.Wait waitTime
‘個数を数える
i = 0
Do While Worksheets(“Sheet1”).Cells(i + 8, “a”).Value <> “”
i = i + 1
Loop
‘Debug.Print i
‘コピー
Worksheets(“Sheet1”).Range(Cells(8, “a”), Cells(8 + i – 1, “g”)).Select
Selection.Copy
‘貼り付け
mITEM.Display
With oApp.ActiveInspector
.WordEditor.Windows(1).Selection.Paste
End With
End Sub
日本IBM出身Worksbooks(outputfile).worksheets(dst).cells(k, “a”) = workbooks(inputfilename).worksheets(src).cells(i, “i”)
do while workbooks(outputfilename).worksheets(dst).cells(k, “a”) <>””
k = k + 1
loop
日本IBM出身Option Explicit
Sub macro_loop2()
Dim i As Integer
i = 2
Do While (Cells(i, 2).Value <> “”)
‘ If i > 50 Then
‘ MsgBox (Cells(i, 2).Value)
‘End If
If Cells(i, 1).Value = 1 Then
MsgBox (Cells(i, 2).Value)
End If
i = i + 1
Loop
End Sub
Sub paste_record_rows()
Dim i As Integer
Dim k As Integer
i = 2 ‘残のレコードへのインデックス
k = 2 ‘パソコン教室フォームのレコードコピー先のインデックス
Do While (Worksheets(“残”).Cells(i, “b”).Value <> “”) ‘発注番号が空でないときに次のブロックを実行＝発注番号が空のときはLoopを抜ける
If (Worksheets(“残”).Cells(i, “a”).Value <> “”) Then ‘チェックがたっていたら次の処理をEnd Ifまで実行
Worksheets(“パソコン教室フォーム”).Cells(k, “a”).Value = Worksheets(“残”).Cells(i, “b”).Value
Worksheets(“パソコン教室フォーム”).Cells(k, “b”).Value = Worksheets(“残”).Cells(i, “i”).Value
Worksheets(“パソコン教室フォーム”).Cells(k, “c”).Value = Worksheets(“残”).Cells(i, “l”).Value
Worksheets(“パソコン教室フォーム”).Cells(k, “d”).Value = Worksheets(“残”).Cells(i, “m”).Value
Worksheets(“パソコン教室フォーム”).Cells(k, “e”).Value = Worksheets(“残”).Cells(i, “h”).Value
Worksheets(“パソコン教室フォーム”).Cells(k, “f”).Value = Worksheets(“残”).Cells(i, “n”).Value
Worksheets(“パソコン教室フォーム”).Cells(k, “g”).Value = Worksheets(“残”).Cells(i, “q”).Value
k = k + 1
End If
i = i + 1
Loop
End Sub
Sub all_clear()
Dim i As Integer
i = 2
Do While (Cells(i, 2).Value <> “”)
Cells(i, 1).Value = “”
i = i + 1
Loop
End Sub
日本IBM出身