SAK 図書館

SAK Streets メインストリート 図書館・カフェ 一覧 SAK Streets 検索
| VB | SQL | Perl | PHP | ASP | JSP | C | PC | HP | FAQ | フリーソフト |

VB テクニック編8 - Excel 起動、Word 起動、メール送信、メール受信

■SAK 関数利用規程

  ・テクニック編で紹介する関数は、私こと Y.SAK の開発関数である。
  ・著作権明示部分の改編は認めない。
  ・個人、企業がこれらの関数を使用したり、一部を使用して新たなシステムや
    プログラムを開発することは自由です。
  ・但し、これらの関数を一部でも使用しているソフトウェアをシェアウェア、
    その他有償プロダクトとして配布・販売するには、私の許可が必要です。
    (無償のフリーソフトウェアなら、自由に配布しても良い。)
  ・これらの関数を使用して発生した、いかなる形での損害も私こと Y.SAK は
    賠償しません。

■Excel 起動(Excel 実行、エクセル起動、エクセル実行)

【使い方】

  ExecExcel "g:\tmp\book1.xls"

'=======================================================================
'  Excel 起動
'=======================================================================
'【引数】
'  para    = シート名
'【戻り値】
'  boolean = 処理結果
'              TRUE  = 正常
'              FALSE = エラー
'【処理】
'  ・Excel を起動する。
'【著作権】
'  ExecExcel() ver 1.00  Copyright (C) 1999 Y.SAK
'【履歴】
'  1999.04.17 sak      ver 1.00 新規作成
'=======================================================================
Public Function ExecExcel(para As String) As Boolean

  Dim exl As variant

'** Excel 起動
  On Local Error Resume Next
  Set exl = CreateObject("Excel.Application")
  shell exl.path & "\excel.exe " & para, 1
  if err <> 0 then
    ExecExcel = False
  else
    ExecExcel = True
  end if
  On Local Error GoTo 0

End Function

■Word 起動(Word 実行、ワード起動、ワード実行)

【使い方】

  ExecWord "g:\tmp\test.doc"

'=======================================================================
'  Word 起動
'=======================================================================
'【引数】
'  para    = 文書ファイル名
'【戻り値】
'  boolean = 処理結果
'              TRUE  = 正常
'              FALSE = エラー
'【処理】
'  ・Word を起動する。
'【著作権】
'  ExecWord() ver 1.00  Copyright (C) 1999 Y.SAK
'【履歴】
'  1999.04.17 sak      ver 1.00 新規作成
'=======================================================================
Public Function ExecWord(para As String) As Boolean

  Dim wrd As variant

'** Word 起動
  On Local Error Resume Next
  Set wrd = CreateObject("Word.Application")
  Shell wrd.path & "\winword.exe " & para, 1
  if err <> 0 then
    ExecWord = False
  else
    ExecWord = True
  end if
  On Local Error GoTo 0

End Function

■電子メール送信

【使い方】

  ・MAPI コンポーネントが、MAPISession1、MAPIMessages1 で配置されている
    ものとして、電子メールを送信する。(電子メール送受信)
  ・MAPI メールソフトして、Outlook Express が使用できる。
    但し、簡易 MAPI クライアントに設定しておくこと。

  ・添付ファイルなしのパターンは次の通り。

  SndMail MAPISession1, MAPIMessages1, "sak@sak-main", "password", _
    "abc@def.com, <ghi@jkl.co.jp>", _
    "SAK <sak@sak-main>", _
    "", _
    "タイトル", _
    "メール本文 1 行目" & vbCrLf & _
    "メール本文 2 行目" & vbCrLf & _
    "メール本文 3 行目" & vbCrLf & _
    "メール本文 4 行目" & vbCrLf & _
    "メール本文 n 行目" & vbCrLf & _
    "", _
    "", _
    ""

  ・添付ファイルありのパターンは次の通り。

  SndMail MAPISession1, MAPIMessages1, "sak@sak-main", "password", _
    "abc@def.com, <ghi@jkl.co.jp>", _
    "SAK <sak@sak-main>", _
    "", _
    "タイトル", _
    "メール本文 1 行目" & vbCrLf & _
    "メール本文 2 行目" & vbCrLf & _
    "メール本文 3 行目" & vbCrLf & _
    "メール本文 4 行目" & vbCrLf & _
    "メール本文 n 行目" & vbCrLf & _
    "", _
    "test.lzh", _
    "g:\tmp\test.lzh"

'=======================================================================
'  電子メール送信
'=======================================================================
'【引数】
'  mses    = MAPISession  コントロール
'  mmsg    = MAPIMessages コントロール
'  id      = メールアカウント ID
'  pw      = メールアカウント パスワード
'  mailto  = 送信先
'  mailcc  = 送信先(カーボンコピー)
'  mailbcc = 送信先(ブラインドカーボンコピー)
'  mailsb  = タイトル
'  mailmsg = 本文
'  attcsb  = 添付バイナリタイトル
'  attcbin = 添付バイナリファイル
'【戻り値】
'  boolean = 処理結果
'              TRUE  = 正常
'              FALSE = エラー
'【処理】
'  ・e-mail を送信する。
'【著作権】
'  SndMail() ver 1.00  Copyright (C) 1999 Y.SAK
'【履歴】
'  1999.04.17 sak      ver 1.00 新規作成
'=======================================================================
Public Function SndMail(mses As Variant, mmsg As Variant, id As String, pw As String, mailto As String, mailcc As String, mailbcc As String, mailsb As String, mailmsg As String, attcsb As String, attcbin As String) As Boolean

  Dim i As Integer
  Dim j As Integer
  Dim k As Integer
  Dim s As String
  Dim s2 As String
  Dim ix As Integer

'** mail 送信
  On Local Error Resume Next
  SndMail = False
  mses.UserName = id
  mses.Password = pw
  mses.SignOn
  mmsg.SessionID = mses.SessionID
  If Err <> 0 Then Exit Function
  mmsg.Compose
  j = 1
  Do
    i = InStr(j, mailto, ",")
    If i = 0 Then
      s = Mid(mailto, j)
    Else
      s = Mid(mailto, j, i - j)
      j = i + 1
    End If
    s = Trim(s)
    k = InStrRev(s, "@")
    If k > 0 Then
      k = InStrRev(s, " ", k)
      If k > 0 Then
        s2 = Trim(Left(s, k - 1))
        If Left(s2, 1) = Chr(&H22) Then s2 = Mid(s2, 2)
        If Right(s2, 1) = Chr(&H22) Then s2 = Left(s2, Len(s2) - 1)
        s = Trim(Mid(s, k + 1))
      Else
        s2 = ""
      End If
      If Left(s, 1) = "<" Then s = Mid(s, 2)
      If Right(s, 1) = ">" Then s = Left(s, Len(s) - 1)
      mmsg.RecipIndex = ix
      mmsg.RecipDisplayName = s2
      mmsg.RecipAddress = s
      mmsg.RecipType = 1
      ix = ix + 1
    End If
  Loop Until i = 0
  j = 1
  Do
    i = InStr(j, mailcc, ",")
    If i = 0 Then
      s = Mid(mailcc, j)
    Else
      s = Mid(mailcc, j, i - j)
      j = i + 1
    End If
    s = Trim(s)
    k = InStrRev(s, "@")
    If k > 0 Then
      k = InStrRev(s, " ", k)
      If k > 0 Then
        s2 = Trim(Left(s, k - 1))
        If Left(s2, 1) = Chr(&H22) Then s2 = Mid(s2, 2)
        If Right(s2, 1) = Chr(&H22) Then s2 = Left(s2, Len(s2) - 1)
        s = Trim(Mid(s, k + 1))
      Else
        s2 = ""
      End If
      If Left(s, 1) = "<" Then s = Mid(s, 2)
      If Right(s, 1) = ">" Then s = Left(s, Len(s) - 1)
      mmsg.RecipIndex = ix
      mmsg.RecipDisplayName = s2
      mmsg.RecipAddress = s
      mmsg.RecipType = 2
      ix = ix + 1
    End If
  Loop Until i = 0
  j = 1
  Do
    i = InStr(j, mailbcc, ",")
    If i = 0 Then
      s = Mid(mailbcc, j)
    Else
      s = Mid(mailbcc, j, i - j)
      j = i + 1
    End If
    s = Trim(s)
    k = InStrRev(s, "@")
    If k > 0 Then
      k = InStrRev(s, " ", k)
      If k > 0 Then
        s2 = Trim(Left(s, k - 1))
        If Left(s2, 1) = Chr(&H22) Then s2 = Mid(s2, 2)
        If Right(s2, 1) = Chr(&H22) Then s2 = Left(s2, Len(s2) - 1)
        s = Trim(Mid(s, k + 1))
      Else
        s2 = ""
      End If
      If Left(s, 1) = "<" Then s = Mid(s, 2)
      If Right(s, 1) = ">" Then s = Left(s, Len(s) - 1)
      mmsg.RecipIndex = ix
      mmsg.RecipDisplayName = s2
      mmsg.RecipAddress = s
      mmsg.RecipType = 3
      ix = ix + 1
    End If
  Loop Until i = 0
  mmsg.MsgSubject = mailsb
  If attcbin <> "" Then
    mmsg.AttachmentIndex = 0
    mmsg.AttachmentPathName = attcbin
    If attcsb <> "" Then
      mmsg.AttachmentName = attcsb
    Else
      mmsg.AttachmentName = GetFilename(attcbin)
    End If
    mmsg.AttachmentPosition = 0
    mmsg.AttachmentType = 0
    mmsg.MsgNoteText = mailmsg
  Else
    mmsg.MsgNoteText = mailmsg
  End If
  If Err <> 0 Then Exit Function
  mmsg.Send False
  If Err <> 0 Then Exit Function
  mses.SignOff
  SndMail = True
  On Local Error GoTo 0

End Function

■電子メール受信

  ・MAPI コンポーネントが、MAPISession1、MAPIMessages1 で配置されている
    ものとして、電子メールを受信する。(電子メール送受信)
    この例では、既読メールも常に処理し、削除を行わない。
    MAPIMessages1.FetchUnreadOnly = True にすると、未読メールだけを処理
    できる。(テスト段階では False でないと面倒である)
    MAPIMessages1.Delete を使用すると処理済みメールを削除できる。
    mid = 送信者ID、msb = タイトル、msg = 本文、と処理している。
    実際に自動処理するには、エラー対策やリカバリも考慮しておくこと。

  Dim i As Integer
  Dim mid As String
  Dim msb As String
  Dim msg As String

  MAPISession1.UserName = "SAK"
  MAPISession1.Password = "SAK"
  MAPISession1.SignOn
  MAPIMessages1.SessionID = MAPISession1.SessionID

  MAPIMessages1.FetchMsgType = ""
  MAPIMessages1.FetchSorted = True
  'MAPIMessages1.FetchUnreadOnly = True
  MAPIMessages1.FetchUnreadOnly = False
  MAPIMessages1.Fetch

  For i = 0 To MAPIMessages1.MsgCount - 1
    MAPIMessages1.MsgIndex = i
    mid = MAPIMessages1.MsgOrigAddress
    msb = MAPIMessages1.MsgSubject
    msg = MAPIMessages1.MsgNoteText
    msgbox mid & chr(10) & msb & chr(10) & msg
    'MAPIMessages1.Delete
  Next

  MAPISession1.SignOff

■VB テクニック編資料
■VB 入門編資料
■VB 基礎編資料
■VB ビジュアル編資料
| VB | SQL | Perl | PHP | ASP | JSP | C | PC | HP | FAQ | フリーソフト |

SAK Streets メインストリート 図書館・カフェ 一覧 SAK Streets 検索



Copyright (C) 1999-2017 Y.SAK