| 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 テクニック編資料

• 2001.06.24 VB テクニック編1 - Windows API、OS 判定、ユーザ取得、初期化ファイル
• 2001.06.24 VB テクニック編2 - Windows API、ウィンドウハンドル取得、ウィンドウ制御
• 2001.06.24 VB テクニック編3 - コマンドパラメタ取得、パス切り出し、半角変換
• 2001.06.24 VB テクニック編4 - 数値変換、文字列変換、バイト操作、まるめ計算
• 2001.06.24 VB テクニック編5 - カレンダー計算、通算日、月末日、うるう年、曜日
• 2001.06.24 VB テクニック編6 - CSV ファイル項目数取得、クイックソート昇順・降順
• 2001.06.24 VB テクニック編7 - コモンダイアログ、編集入力、コントロール制御、メニュー
• 2001.07.12 VB テクニック編8 - Excel 起動、Word 起動、メール送信、メール受信
  • VB テクニック編 - メール送信関数 SndMail 仕様、設定
• 2001.07.12 VB テクニック編9 - 空白除去、文字変換、フォルダ名、パス分解、ファイル日付
• 2001.07.12 VB テクニック編10 - グラフ表示、グリッド、インターネット、外部出力 RDO, ADO
• 2001.07.12 VB テクニック編11 - フォーカス、コンボボックス、チェックボックス、その他
• 2001.07.20 VB テクニック編12 - CSV テキストファイル形式仕様、ハンドリングサンプル
• 2002.04.15 VB テクニック編13 - バッチ実行、EXE バッチ実行、関連付け実行、文字列置換
• 2001.08.22 VB テクニック編14 - 動的コントロール追加、クリスタルレポート印刷
• 2001.08.24 VB テクニック編15 - タイマーイベント、リストボックス選択、データコンポ複数列
• 2001.09.01 VB テクニック編16 - Excel XLS シート読み込み、XLS シート書き込み
• 2001.09.21 VB テクニック編17 - プリンタ一覧取得、プログレスバー、リストビュー
• 2001.09.24 VB テクニック編18 - CSV テキストファイルインポート
• 2001.09.26 VB テクニック編19 - Excel シートインポート、Excel シートエクスポート
• 2001.10.01 VB テクニック編20 - 数値チェック、文字チェック、日付チェック、時間チェック
• 2001.10.03 VB テクニック編21 - RDO、ADO、oo4o 列見出し取得
• 2001.11.03 VB テクニック編22 - ファイル検索、ディレクトリ検索、データグリッド(DataGrid)
• 2001.10.25 VB テクニック編23 - LHA 圧縮解凍 unlha32.dll
• 2001.12.06 VB テクニック編24 - 任意文字カウント、文字列反転、スクロールバー
• 2001.12.08 VB テクニック編25 - oo4o CSV エクスポート、oo4o CSV インポート
• 2001.12.08 VB テクニック編26 - oo4o Excel エクスポート、oo4o Excel インポート
• 2001.12.08 VB テクニック編27 - EBCDIC・JEF ←→ CSV S-JIS コードコンバート
• 2002.02.20 VB テクニック編28 - データベースレコードの特別な排他制御
• 2002.03.10 VB テクニック編29 - CSV ファイル入出力 簡単版、汎用版、無敵版
• 2002.03.10 VB テクニック編30 - 索引ファイル、インデックスファイル、テーブルサーチ
• 2002.03.16 VB テクニック編31 - サブクラスコントロール、フックプロシジャ、メッセージ処理
• 2002.04.08 VB テクニック編32 - ファイル分割・統合、バイナリファイル I/O
• 2002.04.09 VB テクニック編33 - シーケンシャルマッチング、シーケンシャルマージ処理
• 2002.06.12 VB テクニック編34 - テキストファイル行数計算、文字数計算、クリップボード
• 2002.05.21 VB テクニック編35 - メッセージ送受信処理、RegisterWindowMessage
• 2002.06.24 VB テクニック編36 - テキストファイル内文字列検索、ファイル内文字列置き換え
• 2002.07.03 VB テクニック編37 - 二重起動禁止、常に手前に表示、SetWindowPos
• 2003.05.01 VB テクニック編38 - PC 情報取得、OS 種別、ユーザ名、ホスト名、IP アドレス
• 2003.06.01 VB テクニック編39 - Windows 終了、ExitWindowsEx、EWX_POWEROFF

■VB 入門編資料

• 2001.09.24 VB 入門編1 - プログラミング入門、言語環境、言語構造、フリーソフト開発
• 2001.09.24 VB 入門編2 - 変数とは、変数タイプ、変数宣言、定数宣言、アスキーコード
• 2001.09.24 VB 入門編3 - 演算子、比較演算子、論理演算子、is 関数
• 2001.09.24 VB 入門編4 - 注釈、数値リテラル、文字リテラル、トークン、構文、特殊文字
• 2001.09.24 VB 入門編5 - 制御構造、判定、判断、分岐、ループ、if、select case、for、do
• 2001.09.24 VB 入門編6 - 関数構造、function、sub、組み込み標準関数、エラートラップ
• 2001.10.27 VB 入門編7 - NULL 概念、chr(0)、&H0、\0、IsNull

■VB 基礎編資料

• 2000.10.07 VB 基礎編 (その一) 数値計算、変数タイプ、演算子 dim、enum、vbCrLf
• 2000.10.07 VB 基礎編 (その二) 変数宣言、グローバル、ローカル redim、const、type
• 2000.10.07 VB 基礎編 (その三) 制御構造(判定、ループ) if、select case、for、do、while
  • VB 基礎編 - 【補足】条件式 and、or
• 2000.10.07 VB 基礎編 (その四) 標準ファイル I/O open、eof、print、curdir、name、kill
  • ファイルシステムオブジェクト
• 2000.10.07 VB 基礎編 (その五) 関数構造(sub、function) private、public、ByVal、ByRef
• 2000.10.07 VB 基礎編 (その六) 文字列操作 chr、str、trim、left、mid、len、instr、format
• 2000.10.07 VB 基礎編 (その七) 数値関数 int、FormatNumber、FormatCurrency
• 2000.10.24 VB 基礎編 (その八) 日付時間関数 DateSerial、DateDiff、DateAdd、DateValue
• 2000.10.24 VB 基礎編 (その九) その他関数 declare、IsNull、hex、CDec、split、Choose

• 2003.05.07 VB.NET 編1 - 言語仕様変更点、変数タイプ、関数構造、廃止された言語要素

■VB ビジュアル編資料

• 2000.10.08 VB ビジュアル編 (その一) フォーム form_load、form_unload、show、hide
• 2000.10.08 VB ビジュアル編 (その二) ラベル label、caption、refresh、alignment
• 2000.10.08 VB ビジュアル編 (その三) テキストボックス tabindex、text_change、keypress
• 2000.10.08 VB ビジュアル編 (その四) コマンドボタン command_click、default、enabled
• 2000.10.08 VB ビジュアル編 (その五) コンボボックス combo_change、additem、sorted
• 2000.10.08 VB ビジュアル編 (その六) リストボックス list、FileListBox、additem、sorted
• 2000.10.08 VB ビジュアル編 (その七) メッセージボックス MsgBox、InputBox
• 2000.10.08 VB ビジュアル編 (その八) その他関数 sendkeys、setfocus、IMEStatus
• 2002.11.08 VB ビジュアル編 (その九) ユーザコントロール(OCX) 作成、ActiveX ウェブ

| VB | SQL | Perl | PHP | ASP | JSP | C | PC | HP | FAQ | フリーソフト |