VBAで新規メールを作成する

• code

  Sub CreateMail()

      Dim olApp As Outlook.Application
      Dim myMail As Outlook.MailItem, rowIndex As Long, copyRange As Range
      Dim mailNumber As Long

      Call setVariables

      mailNumber = getSettingValue("MailNumber")

      Set olApp = New Outlook.Application
      Set myMail = olApp.CreateItem(olMailItem)

      myMail.To = getAddress("To", mailNumber)
      myMail.CC = getAddress("Cc", mailNumber)
      myMail.BCC = getAddress("Bcc", mailNumber)
      myMail.Subject = mailSheet.Cells(getMailRowIndex("Subject"), 1 + mailNumber).Value

      myMail.Display
      myMail.GetInspector().Activate

      Call setBody(myMail, "Body1", mailNumber)
      Call setBody(myMail, "Body2", mailNumber)
      Call setBody(myMail, "Body3", mailNumber)

  End Sub

  Private Function getAddress(addressType As String, mailNumber As Long)

      Dim myAddress As String, rowIndex As Long, myKey As String, myValue As String


      myAddress = mailSheet.Cells(getMailRowIndex(addressType), 1 + mailNumber).Value

      For rowIndex = 2 To 100
          If addressSheet.Range("A" & rowIndex).Value = "" Then Exit For

          myKey = "[[" & addressSheet.Range("A" & rowIndex).Value & "]]"
          myValue = addressSheet.Range("B" & rowIndex).Value
          myAddress = Replace(myAddress, myKey, myValue)
      Next

      getAddress = myAddress

  End Function

  Private Sub setBody(myMail As Outlook.MailItem, key As String, mailNumber As Long)

      Dim targetRange As Range

      Set targetRange = mailSheet.Cells(getMailRowIndex(key), 1 + mailNumber)
      If targetRange.Value = "" Then Exit Sub

      With myMail.GetInspector().WordEditor.Windows(1).Selection
          .TypeText targetRange.Value
          .TypeText vbCrLf
  '        targetRange.Copy
  '        .Paste
  '        Application.CutCopyMode = False
      End With

  End Sub

  Private Function getMailRowIndex(key As String)
      Dim rowIndex As Long
      For rowIndex = 1 To Rows.Count
          If LCase(mailSheet.Range("A" & rowIndex).Value) = "end" Then Exit For
          If LCase(mailSheet.Range("A" & rowIndex).Value) = LCase(key) Then
              getMailRowIndex = rowIndex
              Exit For
          End If
      Next
  End Function