VB.NETでメールを送信する方法 [プログラミング]
VB.NETでメールを送信する方法について説明する。
ここで説明する内容は、前回のC#.NETでメールを送信する方法のVB.NET版である。
基本的な実装方法はC#.NETと同様なので詳しい説明は割愛する。
C#.NET版と異なる点は、メール送信に関するコードの記述をクラス化(clsMailクラス)しているということで、フォームに入力された内容をclsMailクラスのプロパティに設定してからSendMailプロシージャを実行している。
また、SendMailの戻り値がFalse(メール送信失敗)の場合に失敗の原因分けのコードも追加している。
以下がそのサンプルコード(抜粋)である。
------------------------------------------------------------
Module modMain
Private Function fncSendMail(ByVal pToAddressee As String, ByVal pSubject As String, ByVal pBody As String, _
ByVal pPriority As Net.Mail.MailPriority, ByVal pOwner As Form) As Boolean
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'メールを送信
'
' pToAddressee : メール宛先
' pSubject : メール件名
' pBody : メール本文
' pPriority : メール優先度
' pOwner : オーナーウインドウインスタンス
'
' Return : True:正常、False:異常
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim blnReturn As Boolean = False
Dim clsSnedMail As clsMail = Nothing
Try
'メール送信クラスのインスタンスを生成
clsSnedMail = New clsMail()
With clsSnedMail
'各種プロパティを設定
.SmtpHost = "smtp.xxxxxxxx.ne.jp"
.UserName = "username"
.Password = "password"
.FromAddress = "username@xxxxxxxx.ne.jp"
.ToAddress = pToAddressee
.Subject = pSubject
.Body = pBody
.Priority = pPriority
'メールを送信
Dim intStatusCode As System.Net.Mail.SmtpStatusCode = 0
Dim intReTry As Integer = 0
Do While blnReturn = False
If .SendMail(intStatusCode) = False Then
'メール送信が失敗した場合、ステータスコードをチェック
Select Case intStatusCode
Case Net.Mail.SmtpStatusCode.MailboxBusy, Net.Mail.SmtpStatusCode.MailboxUnavailable
'メールボックスが使用中の場合
If intReTry >= 10 Then
'再送信回数が規定回数に達してもメールが送信できない場合
'
'エラー処理を記述
'
Exit Do
End If
'5秒待機してから再送信
Threading.Thread.Sleep(5000)
intStatusCode = 0
intReTry += 1
Continue Do
Case Net.Mail.SmtpStatusCode.ClientNotPermitted
'クライアントが認証されなかった場合
'
'エラー処理を記述
'
Exit Do
Case Else
'その他のエラー
'
'エラー処理を記述
'
Exit Do
End Select
End If
blnReturn = True
Loop
If blnReturn = False Then
'メール送信に失敗した場合
'
'エラー処理を記述
'
End If
End With
blnReturn = True
Catch ex As Exception
'
'エラー処理を記述
'
blnReturn = False
Finally
'メール送信クラスのインスタンスを破棄
clsSnedMail = Nothing
End Try
Return blnReturn
End Function
End Module
Imports System
Imports System.Net
Imports System.Net.Mail
Public Class clsMail
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'メール送信クラス
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'定数宣言
Private Const CON_SERVER_PORT As Integer = 25
'メール送信用変数
Private strSmtpHost As String
Private strUserName As String
Private strPassword As String
Private strFromAddress As String
Private strToAddress As String
Private strSubject As String
Private strBody As String
Private intPriority As MailPriority
Public WriteOnly Property SmtpHost() As String
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'SMTPサーバ名
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Set(value As String)
strSmtpHost = value
End Set
End Property
'
'この間に同様のプロパティに関する記述をする。
'
Public WriteOnly Property Priority As MailPriority
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'優先度
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Set(value As MailPriority)
intPriority = value
End Set
End Property
Public Sub New()
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'メール送信クラスのコンストラクター
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'メール送信用変数の初期化
SmtpHost = String.Empty
UserName = String.Empty
Password = String.Empty
FromAddress = String.Empty
ToAddress = String.Empty
Subject = String.Empty
Body = String.Empty
Priority = MailPriority.Normal
End Sub
Public Function SendMail(ByRef pStatusCode As SmtpStatusCode) As Boolean
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'メール送信を実行
'
' Return : True:正常、False:異常
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim blnReturn As Boolean
Dim scMail As SmtpClient = Nothing
Dim msgMail As MailMessage = Nothing
Try
'メール送信用SmtpClientオブジェクトのインスタンスを生成
scMail = New SmtpClient()
'メールメッセージオブジェクトのインスタンスを生成
msgMail = New MailMessage(strFromAddress, strToAddress, strSubject, strBody)
msgMail.Priority = intPriority
'SmtpClientを設定
With scMail
.Host = strSmtpHost
.Port = CON_SERVER_PORT
.DeliveryMethod = SmtpDeliveryMethod.Network
.Credentials = New NetworkCredential(strUserName, strPassword)
End With
'メールを送信
scMail.Send(msgMail)
pStatusCode = SmtpStatusCode.Ok
blnReturn = True
Catch smtpex As SmtpException
pStatusCode = smtpex.StatusCode
blnReturn = False
Catch ex As Exception
pStatusCode = 0
blnReturn = False
Finally
'メール送信用オブジェクトを破棄
msgMail.Dispose()
msgMail = Nothing
scMail = Nothing
End Try
Return blnReturn
End Function
End Class
------------------------------------------------------------
C#.NETでメールを送信する方法 [プログラミング]
C#.NETでメールを送信する方法について説明する。
ここで説明するメール送信はSmtpClientクラス(System.Net.Mail名前空間)を利用する。
簡単な処理の流れは以下の通り。
1.SmtpClientクラスのインスタンスの生成
2.SMTPサーバ、送信ポートの設定
3.差出人の資格情報の設定
4.メールの送信
5.各種インスタンスの破棄
では、その詳細を説明していこう。
1.SmtpClientクラスのインスタンスの生成
ここではSmtpClientクラスのほか、メールの送信内容の設定も行う。
①SmtpClientクラスのインスタンスの生成
初期化の方法はいくつかあるが、取り敢えずここではSMTPサーバも送信ポートも指定せずに初期化する。
②MailMessageクラスのインスタンスの生成
送信するメールの宛先、差出人、件名、本文等のメッセージを作成するためにMailMessageクラス(System.Net.Mail名前空間)のインスタンスを生成する。
必要最低限の情報(宛先のメールアドレス文字列、差出人のメールアドレス文字列、件名となる文字列、本文となる文字列)で初期化を行う。
※今回は特に設定しないが、MailMessageクラスのインスタンスを生成した後、CC、BCCおよび優先度等の各プロパティを設定することも可能である。
2.SMTPサーバ、送信ポートの設定
SMTPサーバ、送信ポート等メール送信にするための設定手順は以下の通り。
①SMTPサーバの設定
SmtpClientクラスのインスタンスのHostプロパティにSMTPサーバのホスト名を設定する。
②送信ポートの設定
SmtpClientクラスのインスタンスのPortプロパティに送信ポート番号を設定する。
規定値が25なので、変更がなければ設定しなくても問題ない。
③送信メッセージの処理方法の設定
SmtpClientクラスのインスタンスのDeliveryMethodプロパティにSmtpDeliveryMethod列挙体のNetworkの値を設定する。
この値を設定することでメールがネットワーク経由でSMTPサーバに送信される。
3.差出人の資格情報の設定
メールを送信するための差出人の認証に使用する資格情報の設定手順は以下の通り。
①資格情報の設定
SmtpClientクラスのインスタンスのCredentialsプロパティにNetworkCredentialクラス(System.Net.Mail名前空間)のインスタンスを設定する。
NetworkCredentialクラスのインスタンスはユーザ名、パスワードで初期化する。
4.メールの送信
ここまでくれば、後はメールを送信するだけである。
SmtpClientクラスのインスタンスのSendメソッドにMailMessageクラスのインスタンスを指定して実行する。
※今回はメール送信結果のチェックは行っていないが、送信結果をチェックする場合はTry...Catchステートメントを使用してSmtpExceptionクラスのStatusCodeプロパティを確認すれば良い。
5.各種インスタンスの破棄
①MailMessageクラスのインスタンスを破棄する。
②SmtpClientクラスのインスタンスを破棄する。
上記の手順でSMTPサーバを使用したメールの送信が行える。
以下は、上記メール送信手順のサンプルコード(抜粋)である。
フォームには以下のテキストボックスとボタンが配置されているものとする。
・差出人アドレス
・宛先アドレス
・件名
・本文
・送信ボタン
------------------------------------------------------------
private void btnSend_Click(object sender, EventArgs e)
{
//送信ボタン押下時の処理
string FromAddress = txtFrom.Text;
string ToAddress = txtTo.Text;
string Subject = txtSubject.Text;
string Body = txtBody.Text;
System.Net.Mail.MailMessage Msg = new System.Net.Mail.MailMessage(FromAddress, ToAddress, Subject, Body);
System.Net.Mail.SmtpClient Sc=new System.Net.Mail.SmtpClient();
try
{
Sc.Host = "smtp.xxxxxxxx.ne.jp";
Sc.Port = 25;
Sc.DeliveryMethod = System.Net.Mail.SmtpDeliveryMethod.Network;
Sc.Credentials = new System.Net.NetworkCredential("username", "password");
var result = MessageBox.Show(ToAddress + "にメールを送信します。" + Environment.NewLine + "よろしいですか。",
this.Text, MessageBoxButtons.YesNo, MessageBoxIcon.Question);
if (result == DialogResult.No)
{
MessageBox.Show("メールの送信を中止しました。", this.Text,MessageBoxButtons.OK,MessageBoxIcon.Stop);
return;
}
Sc.Send(Msg);
MessageBox.Show("メールの送信が完了しました。", this.Text,MessageBoxButtons.OK,MessageBoxIcon.Information);
txtBody.Text = ""; txtSubject.Text = "";
}
catch(Exception ex)
{
MessageBox.Show(ex.Message, this.Text,MessageBoxButtons.OK,MessageBoxIcon.Exclamation);
}
finally
{
Msg.Dispose();
Sc.Dispose();
}
}
------------------------------------------------------------
C#.NETでFTPダウンロードを実装する方法 [プログラミング]
C#.NETでFTPダウンロードを実装する方法について説明する。
ここで説明する内容は、前回のVB.NETでFTPダウンロードを実装する方法のC#.NET版である。
基本的な実装方法はVB.NETと同様なので詳しい説明は割愛する。
VB.NET版と異なる点は、FTPに関するコードの記述をクラス化(clsFtpクラス)しているということで、フォームに入力された内容をclsFtpクラスのプロパティに設定してからfncGetFileForFtpプロシージャを実行している。
以下がそのサンプルコード(抜粋)である。
------------------------------------------------------------
namespace TestFtp
{
public partial class frmMain : Form
{
private void btnConnect_Click(object sender, EventArgs e)
{
//＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
//接続ボタン押下時の処理
//＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
//Ftpクラスの生成
clsFtp clsFtp = new clsFtp();
//各種ユーザ入力情報の取得
clsFtp.FireWallServer = txtFireWallServer.Text.Trim();
clsFtp.FireWallUser = txtFireWallUser.Text.Trim();
clsFtp.FireWallPassword = txtFireWallPassword.Text.Trim();
clsFtp.HostProxy = txtHostProxy.Text.Trim();
clsFtp.HostServer = txtHostServer.Text.Trim();
clsFtp.HostUser = txtHostUser.Text.Trim();
clsFtp.HostPassword = txtHostPassword.Text.Trim();
clsFtp.HostPath = txtHostPath.Text.Trim();
clsFtp.HostFile = txtHostFile.Text.Trim();
clsFtp.ClientPath = txtClientPath.Text.Trim();
clsFtp.ClientFile = txtClientFile.Text.Trim();
//ログ出力先を設定
clsFtp.Log = txtLog;
//指定ファイルをFTPでサーバより取得
clsPublic clsPublic = new clsPublic();
if (clsFtp.fncGetFileForFtp() == false)
{
clsPublic.fncMessagePut("ファイルの取得に失敗しました。", MessageBoxButtons.OK, MessageBoxIcon.Exclamation);
}
else
{
clsPublic.fncMessagePut("ファイルの取得が完了しました。", MessageBoxButtons.OK, MessageBoxIcon.Information);
}
}
}
}
using System;
using System.Text;
using System.Net;
using System.Net.Sockets;
using System.Windows.Forms;
namespace TestFtp
{
class clsFtp
{
private string strFireWallServer;
private string strFireWallUser;
private string strFireWallPassword;
private string strHostProxy;
private string strHostServer;
private string strHostUser;
private string strHostPassword;
private string strHostPath;
private string strHostFile;
private string strClientPath;
private string strClientFile;
private TextBox txtLog;
private Socket socClient;
private System.IO.FileStream fsData;
private Encoding encASC = new ASCIIEncoding();
private Encoding encU8 = new UTF8Encoding();
public string FireWallServer
{
get { return strFireWallServer; }
set { strFireWallServer = value; }
}
public string FireWallUser
{
get { return strFireWallUser; }
set { strFireWallUser = value; }
}
public string FireWallPassword
{
get { return strFireWallPassword; }
set { strFireWallPassword = value; }
}
public string HostProxy
{
get { return strHostProxy; }
set { strHostProxy = value; }
}
public string HostServer
{
get { return strHostServer; }
set { strHostServer = value; }
}
public string HostUser
{
get { return strHostUser; }
set { strHostUser = value; }
}
public string HostPassword
{
get { return strHostPassword; }
set { strHostPassword = value; }
}
public string HostPath
{
get { return strHostPath; }
set { strHostPath = value; }
}
public string HostFile
{
get { return strHostFile; }
set { strHostFile = value; }
}
public string ClientPath
{
get { return strClientPath; }
set { strClientPath = value; }
}
public string ClientFile
{
get { return strClientFile; }
set { strClientFile = value; }
}
public TextBox Log
{
get { return txtLog; }
set { txtLog = value; }
}
public Socket Client
{
get { return socClient; }
set { socClient = value; }
}
public Boolean fncGetFileForFtp()
{
//＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
//FTPで指定サーバより指定ファイルをダウンロード
//
// 戻り値 : True:正常、False:異常
//
//＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Boolean blnReturn;
Boolean blnConnect = false;
try
{
txtLog.Clear();
//ソケットオブジェクトの生成
Client = new Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp);
//FireWallサーバの接続先とポートを生成
IPEndPoint iepFwIp = new IPEndPoint(Dns.GetHostEntry(FireWallServer).AddressList[0], 21);
//FireWallサーバに接続
Client.Connect(iepFwIp);
//FireWallにログイン
if (fncSendCommand("USER " + FireWallUser) == false)
{
blnReturn = false;
goto Fin;
}
blnConnect = true;
if (fncSendCommand("PASS " + FireWallPassword, FireWallPassword) == false)
{
blnReturn = false;
goto Fin;
}
//サーバにログイン
if (fncSendCommand("USER " + HostUser + "@" + HostServer + "@" + HostProxy) == false)
{
blnReturn = false;
goto Fin;
}
if (fncSendCommand("PASS " + HostPassword, HostPassword) == false)
{
blnReturn = false;
goto Fin;
}
//転送モードをASCIIに設定
if (fncSendCommand("TYPE A") == false)
{
blnReturn = false;
goto Fin;
}
//クライアントのIPアドレスと受信ポートを設定
IPAddress ipaMyIp = Dns.GetHostAddresses(Dns.GetHostName())[1];
TcpListener tlnData = new TcpListener(ipaMyIp, 0);
tlnData.Start();
int intMyPort = (int)((IPEndPoint)tlnData.LocalEndpoint).Port;
//送受信ポートを設定
if (fncSendCommand("PORT " + ipaMyIp.ToString().Replace(".", ",") + "," + (intMyPort / 256) + "," + (intMyPort % 256)) == false)
{
blnReturn = false;
goto Fin;
}
//ダウンロードを要求するファイルを送信
if (fncSendCommand("RETR " + HostPath + "/" + HostFile) == false)
{
blnReturn = false;
goto Fin;
}
//ファイルをダウンロード
Socket socData = tlnData.AcceptSocket();
fsData = new System.IO.FileStream(System.IO.Path.Combine(ClientPath, ClientFile),
System.IO.FileMode.Create, System.IO.FileAccess.Write);
byte[] bytBuffer = new byte[1023];
DateTime datStart = DateTime.Now;
while(true)
{
int intSize=socData.Receive(bytBuffer);
if (intSize == 0)
{ break; }
fsData.Write(bytBuffer, 0, intSize);
}
TimeSpan tsSpan = DateTime.Now - datStart;
if (fncReceiveData() == false)
{
blnReturn = false;
goto Fin;
}
string strMsg = "ダウンロードは正常に終了しました。 (" + Math.Ceiling(tsSpan.TotalSeconds) + "SEC. " +
(int)(fsData.Length / Math.Ceiling(tsSpan.TotalSeconds)) + "B/S)";
subPutLog(strMsg);
fsData.Close();
socData.Close();
blnReturn = true;
}
catch(Exception ex)
{
clsPublic clsPublic = new clsPublic();
clsPublic.fncMessagePut(ex.Message, MessageBoxButtons.OK, MessageBoxIcon.Exclamation);
blnReturn = false;
}
finally
{
if (blnConnect == true)
{
if (fsData != null)
{
//出力ファイルを閉じる
fsData.Close();
}
//接続を閉じる
fncSendCommand("QUIT");
Client.Shutdown(SocketShutdown.Both);
Client.Close();
}
Client.Dispose();
Client = null;
}
Fin:
return blnReturn;
}
private Boolean fncReceiveData()
{
//＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
//サーバから応答メッセージを取得
//
// 戻り値 : True:正常、False:異常
//
//＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Boolean blnReturn;
byte[] bytData = new byte[255];
int intLen;
string strData;
try
{
while(Client.Available>0)
{
//サーバからの応答を受信
intLen=Client.Receive(bytData);
//受信したメッセージのバイト列を文字列に変換
strData = encU8.GetString(bytData, 0, intLen);
subPutLog(strData);
System.Threading.Thread.Sleep(250);
}
blnReturn = true;
}
catch (Exception ex)
{
clsPublic clsPublic = new clsPublic();
clsPublic.fncMessagePut(ex.Message, MessageBoxButtons.OK, MessageBoxIcon.Exclamation);
blnReturn = false;
}
return blnReturn;
}
private Boolean fncSendCommand(string pCommand,string pPassword = "")
{
//＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
//サーバにコマンドを送信
//
// pCommand : 送信コマンド文字列
// pPassword : パスワード文字列
//
// 戻り値 : True:正常、False:異常
//
//＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Boolean blnReturn;
try
{
//ログを出力
pCommand = pCommand + "\r\n";
subPutLog(">" + pCommand, pPassword);
//送信するコマンドをASCIIのバイト列に変換
byte[] bytCommand = encASC.GetBytes(pCommand);
//コマンドを送信
Client.Send(bytCommand, bytCommand.Length, SocketFlags.None);
System.Threading.Thread.Sleep(250);
//サーバからの応答を受信
if (fncReceiveData() == false)
{
blnReturn = false;
}
else
{
blnReturn = true;
}
}
catch(Exception ex)
{
clsPublic clsPublic = new clsPublic();
clsPublic.fncMessagePut(ex.Message, MessageBoxButtons.OK, MessageBoxIcon.Exclamation);
blnReturn = false;
}
return blnReturn;
}
private void subPutLog(string pMsg,string pPassword = "")
{
//＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
//ログを出力
//
// pMsg : メッセージ文字列
// pPassword : パスワード文字列
//
//＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
if (txtLog.Text != "" && txtLog.Text.Substring(txtLog.TextLength - 2) != "\r\n")
{
txtLog.AppendText("\r\n");
}
if (pPassword != string.Empty)
{
pMsg=pMsg.Replace(pPassword,"[" + new string('X',pPassword.Length) + "]");
}
txtLog.AppendText(pMsg);
Application.DoEvents();
}
}
}
------------------------------------------------------------
VB.NETでFTPダウンロードを実装する方法 [プログラミング]
VB.NETでFTPダウンロードを実装する方法について説明する。
ここで説明するFTPダウンロードは、FireWallサーバにログインした後、プロキシサーバを経由して目的のサーバに接続する形式である。
プロキシを経由しないFTP接続のサンプルはたくさんあるようなので、ここではプロキシ経由のサンプルを紹介する。
FTPクライアントにはSystem.Net.Sockets名前空間のSocketクラスを使用するしSystem.Net名前空間を多用するので、System.Netをインポートしておくと良い。
簡単に処理の流れは以下の通り。
1.Socketクラスのインスタンスの生成
2.FireWallサーバにログイン
3.プロキシサーバを経由して目的サーバにログイン
4.転送モード、送受信ポートの設定
5.ファイルのダウンロード
6.サーバとの接続を閉じる
では、その詳細を説明していこう。
1.Socketクラスのインスタンスの生成
Socketクラスのインスタンスの生成は「アドレスファミリ、ソケットタイプおよびプロトコル」を指定してインスタンスの初期化を行う。
アドレスファイミリは"InterNetwork"、ソケットタイプは"Stream"、そしてプロトコルは"Tcp"を指定する。
2.FireWallサーバにログイン
FireWallサーバにログインするための手順は以下の通り。
①IPEndPointクラス(System.Net名前空間)のインスタンスの生成
FireWallサーバに接続するためにIPEndPointクラスのインスタンスを生成して、接続先のホストとポートの情報を格納する。
IPアドレスにはDnsクラスのGetHostEntryメソッドにFireWallサーバの名前(名前解決ができていれば)またはIPアドレスを指定して実行した結果のAddressListプロパティの0番目要素を、ポート番号には21を指定してインスタンスの初期化を行う。
②FireWallサーバに接続
SocketクラスのインスタンスのConnectメソッドに先ほど生成したIPEndPointクラスのインスタンスを指定して実行してFireWallサーバに接続する。
③FireWallサーバにログイン
SocketクラスのインスタンスのSendメソッドに"USER [FireWallサーバの名前またはIPアドレス]"を指定して実行する。
※Sendメソッドの詳しい実装方法は後程説明する。
続いてSocketクラスのインスタンスのReceiveメソッドを実行してサーバからの応答を受信する。
※Receiveメソッドの詳しい実装方法は後程説明する。
④FireWallユーザのパスワード送信
SocketクラスのインスタンスのSendメソッドに"PASS [FireWallユーザのパスワード]"を指定して実行する。
続いてSocketクラスのインスタンスのReceiveメソッドを実行してサーバからの応答を受信する。
以上でFireWallサーバへのログインは完了である。
3.プロキシサーバを経由して目的サーバにログイン
プロキシサーバ経由で目的サーバにログインするための手順は以下の通り。
①目的サーバにログイン
SocketクラスのインスタンスのSendメソッドに"USER [ユーザ名]@[目的サーバの名前またはIPアドレス]@[プロキシサーバの名前またはIPアドレス]"を指定して実行する。
因みにプロキシサーバを経由しない場合は"USER [ユーザ名]@[目的サーバの名前またはIPアドレス]"を指定する。
続いてSocketクラスのインスタンスのReceiveメソッドを実行してサーバからの応答を受信する。
②目的サーバのログインパスワード送信
SocketクラスのインスタンスのSendメソッドに"PASS [目的サーバのログインパスワード]"を指定して実行する。
続いてSocketクラスのインスタンスのReceiveメソッドを実行してサーバからの応答を受信する。
以上で目的サーバへのログインは完了である。
4.転送モード、送受信ポートの設定
転送モード、送受信ポートの設定手順は以下の通り。
①転送モードをASCIIに設定
SocketクラスのインスタンスのSendメソッドに"TYPE A"を指定して実行する。
続いてSocketクラスのインスタンスのReceiveメソッドを実行してサーバからの応答を受信する。
②クライアントのIPアドレスの取得
IPAddressクラス(System.Net名前空間)のインスタンスにDnsクラスのGetHostAddressesメソッドの実行結果の1番目要素を設定する。
DnsクラスのGetHostAddressesメソッドにはDnsクラスのGetHostNameメソッドの実行結果を指定する。
③Tcpリスナーの生成
TcpListenerクラス(System.Net.Sockets名前空間)のインスタンスを生成する。
IPアドレスには先ほど生成したIPAddressクラスのインスタンスを、ポートには0を指定して初期化する。
④Tcpリスナーの受信接続要求開始
TcpListenerクラスのインスタンスのStartメソッドを実行して受信接続要求の待機を開始する。
⑤クライアントの受信ポートの取得
TcpListenerクラスのインスタンスのLocalEndpointプロパティをIPEndPointに型変換し、そのPortプロパティの値を取得する。
⑥送受信ポートの設定
SocketクラスのインスタンスのSendメソッドに"PROT [IPAddressクラスのインスタンスを文字列変換した値の"."(ピリオド)を","(カンマ)に変換した値],[クライアント受信ポート番号÷256の商],[クライアント受信ポート番号÷256の剰余]"を指定して実行する。
続いてSocketクラスのインスタンスのReceiveメソッドを実行してサーバからの応答を受信する。
以上で転送モード、送受信ポートの設定は完了である。
5.ファイルのダウンロード
ファイルのダウンロードの手順は以下の通り。
①ダウンロードを要求するファイルの送信
SocketクラスのインスタンスのSendメソッドに"RETR [ダウンロードするファイルのフルパス]"を指定して実行する。
続いてSocketクラスのインスタンスのReceiveメソッドを実行してサーバからの応答を受信する。
②ファイルのダウンロード
Socketクラス(System.Net.Sockets名前空間)のインスタンスを生成し、TcpListenerクラスのインスタンスのAcceptSocketプロパティの値を設定する。
FileStreamクラス(IO名前空間)のインスタンスを生成し、ダウンロード先ファイルのフルパスで初期化する。
受信データが0バイトになるまでSocketクラスのインスタンスのReceiveメソッドで取得したバイト型の配列の値をFileStreamクラスのインスタンスのWriteメソッドでファイルに出力する。
ファイルの受信が完了したらSocketクラスのインスタンスのReceiveメソッドを実行してサーバからの応答を受信する。
③各インスタンスのクローズ
FileStreamクラスのインスタンスのCloseメソッドを実行してダウンロード先ファイルを閉じる。
SocketクラスのインスタンスのCloseメソッドを実行してファイル受信ソケットを閉じる。
TcpListenerクラスのインスタンスのStopメソッドを実行してTcpリスナーを閉じる。
以上でファイルのダウンロードは完了である。
6.サーバとの接続を閉じる
サーバとの接続終了の手順は以下の通り。
①サーバとの接続を閉じる
SocketクラスのインスタンスのSendメソッドに"QUIT"を指定して実行する。
続いてSocketクラスのインスタンスのReceiveメソッドを実行してサーバからの応答を受信する。
②ソケット接続の終了
SocketクラスのインスタンスのShutdownメソッドを実行してソケットの送受信を終了する。
SocketクラスのインスタンスのCloseメソッドを実行してソケットの接続を閉じる。
上記の手順でプロキシサーバ経由のFTPダウンロードが行える。
もっとも、プロキシサーバ経由か否かは目的サーバへのログインが異なるだけ(そこが肝心な部分だが…)で、その他はプロキシ経由か否かに関係なく同じ手順である。
説明を保留していたSocketクラスのインスタンスのSendメソッドとReceiveメソッドについて以下に説明する。
1.Sendメソッド
SocketクラスのインスタンスのSendメソッドでコマンドを送信する手順は以下の通り。
①送信するコマンドをバイト列に変換
送信するコマンドをASCIIEncodingで初期化したEncodingクラス(Text名前空間)のインスタンスのGetBytesメソッドを実行して、ASCIIのバイト列に変換する。
②コマンドの送信
SocketクラスのインスタンスのSendメソッドに送信するコマンドのASCIIのバイト列とその長さを指定して実行する。
2.Receiveメソッド
SocketクラスのインスタンスのReceiveメソッドでサーバからの応答を受信する手順は以下の通り。
①サーバからの応答の受信
SocketクラスのインスタンスのAvailableプロパティの値＞0の間、以下の処理を繰り返す。
SocketクラスのインスタンスのReceiveメソッドを実行してバイト列にデータを受信する。
受信したバイト列のデータをUTF8Encodingで初期化したEncodingクラス(Text名前空間)のインスタンスのGetStringメソッドを実行して、文字列に変換する。
以下は、上記FTPダウンロード手順のサンプルコード(抜粋)である。
フォームには以下のテキストボックスとボタンが配置されているものとする。
・FireWallサーバ名
・FireWallユーザ名
・FireWallパスワード
・プロキシサーバ名
・ホストサーバ名
・ホストサーバユーザ名
・ホストサーバパスワード
・ダウンロード元パス
・ダウンロード元ファイル名
・ダウンロード先パス
・ダウンロード先ファイル名
・実行ログ
・接続ボタン
フォームの各テキストボックスに値を入力し、接続ボタンを押下するとFTPダウンロードが始まり、サーバとの送受信内容が実行ログテキストボックスに出力される仕様である。
以下のサンプルではサーバへのコマンド送信後、サーバからの応答メッセージを受信する際にコマンドエラーのハンドリングを行っていないが、エラーハンドリングを行うのであれば受信データを文字列変換した後にエラーコードもしくはメッセージが含まれていないかをチェックすると良い。
因みにこのサンプルの接続先サーバはLinuxサーバである。
------------------------------------------------------------
Private gstrFireWallServer As String
Private gstrFireWallUser As String
Private gstrFireWallPassword As String
Private gstrHostProxy As String
Private gstrHostServer As String
Private gstrHostUser As String
Private gstrHostPassword As String
Private gstrHostPath As String
Private gstrHostFile As String
Private gstrClientPath As String
Private gstrClientFile As String
Private goClient As Sockets.Socket
Private goEncASC As Text.Encoding = New Text.ASCIIEncoding
Private goEncU8 As Text.Encoding = New Text.UTF8Encoding
Private Sub btnConnect_Click(sender As Object, e As System.EventArgs) Handles btnConnect.Click
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'接続ボタン押下時の処理
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'各種ユーザ入力情報の取得
gstrFireWallServer = txtFireWallServer.Text.Trim
gstrFireWallUser = txtFireWallUser.Text.Trim
gstrFireWallPassword = txtFireWallPassword.Text.Trim
gstrHostProxy = txtHostProxy.Text.Trim
gstrHostServer = txtHostServer.Text.Trim
gstrHostUser = txtHostUser.Text.Trim
gstrHostPassword = txtHostPassword.Text.Trim
gstrHostPath = txtHostPath.Text.Trim
gstrHostFile = txtHostFile.Text.Trim
gstrClientPath = txtClientPath.Text.Trim
gstrClientFile = txtClientFile.Text.Trim
'指定ファイルをFTPでサーバより取得
If fncGetFileForFtp() = False Then
Me.fncMessageput("ファイルの取得に失敗しました。", MsgBoxStyle.Exclamation)
Else
Me.fncMessageput("ファイルの取得が完了しました。", MsgBoxStyle.Information)
End If
End Sub
Private Function fncGetFileForFtp() As Boolean
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'FTPで指定サーバより指定ファイルをダウンロード
'
' 戻り値 : True:正常、False:異常
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim blnReturn As Boolean
Dim blnConnect As Boolean = False
Try
txtLog.Clear()
'ソケットオブジェクトの生成
goClient = New Sockets.Socket(Sockets.AddressFamily.InterNetwork, Sockets.SocketType.Stream, Sockets.ProtocolType.Tcp)
'ホスト(FireWall)の接続先とポートを生成
Dim objFwIp As IPEndPoint = New IPEndPoint(Dns.GetHostEntry(gstrFireWallServer).AddressList(0), 21)
'ホストに接続
goClient.Connect(objFwIp)
'FireWallにログイン
If fncSendCommand("USER " & gstrFireWallUser) = False Then
Exit Try
End If
If fncReceiveData() = False Then
Exit Try
End If
blnConnect = True
If fncSendCommand("PASS " & gstrFireWallPassword, gstrFireWallPassword) = False Then
Exit Try
End If
If fncReceiveData() = False Then
Exit Try
End If
'サーバにログイン
If fncSendCommand("USER " & gstrHostUser & "@" & gstrHostServer & "@" & gstrHostProxy) = False Then
Exit Try
End If
If fncReceiveData() = False Then
Exit Try
End If
If fncSendCommand("PASS " & gstrHostPassword, gstrHostPassword) = False Then
Exit Try
End If
If fncReceiveData() = False Then
Exit Try
End If
'転送モードをASCIIに設定
If fncSendCommand("TYPE A") = False Then
Exit Try
End If
If fncReceiveData() = False Then
Exit Try
End If
'クライアントのIPアドレスと受信ポートを設定
Dim objMyIp As IPAddress = Dns.GetHostAddresses(Dns.GetHostName())(1)
Dim objListener As Sockets.TcpListener = New Sockets.TcpListener(objMyIp, 0)
objListener.Start()
Dim intMyPort As Integer = CInt(DirectCast(objListener.LocalEndpoint, IPEndPoint).Port.ToString())
'送受信ポートを設定
If fncSendCommand("PORT " & objMyIp.ToString.Replace(".", ",") & "," & (intMyPort \ 256) & "," & (intMyPort Mod 256)) = False Then
Exit Try
End If
If fncReceiveData() = False Then
Exit Try
End If
'ダウンロードを要求するファイルを送信
If fncSendCommand("RETR " & gstrHostPath & "/" & gstrHostFile) = False Then
Exit Try
End If
If fncReceiveData() = False Then
Exit Try
End If
'ファイルをダウンロード
Dim objSoc As Sockets.Socket = objListener.AcceptSocket
Dim objStream As New IO.FileStream(IO.Path.Combine(gstrClientPath, gstrClientFile), IO.FileMode.Create, IO.FileAccess.Write)
Dim bytBuffer(1023) As Byte
Dim datStart As Date = Now()
Do
Dim intSize As Integer = objSoc.Receive(bytBuffer)
If intSize = 0 Then
Exit Do
End If
objStream.Write(bytBuffer, 0, intSize)
Loop
Dim datSpan As TimeSpan = Now() - datStart
If fncReceiveData() = False Then
Exit Try
End If
Dim strMsg As String = "ダウンロードは正常に終了しました。 (" & CInt(datSpan.TotalSeconds).ToString & "SEC. " & _
CInt(objStream.Length / datSpan.TotalSeconds).ToString & "B/S)"
Me.subPutLog(strMsg)
objStream.Close()
objSoc.Close()
objListener.Stop()
blnReturn = True
Catch ex As Exception
Me.fncMessageput(ex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
Finally
If blnConnect = True Then
'接続を閉じる
Call fncSendCommand("QUIT")
Call fncReceiveData()
goClient.Shutdown(Sockets.SocketShutdown.Both)
goClient.Close()
End If
goClient.Dispose()
goClient = Nothing
End Try
Return blnReturn
End Function
Private Function fncReceiveData() As Boolean
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'サーバから応答メッセージを取得
'
' 戻り値 : True:正常、False:異常
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim blnReturn As Boolean
Dim bytData(255) As Byte
Dim intLen As Integer
Dim strData As String
Try
Do While goClient.Available > 0
'サーバからの応答を受信
intLen = goClient.Receive(bytData)
'受信したメッセージのバイト列を文字列に変換
strData = goEncU8.GetString(bytData, 0, intLen)
Me.subPutLog(strData)
Threading.Thread.Sleep(250)
Loop
blnReturn = True
Catch ex As Exception
Me.fncMessageput(ex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
End Try
Return blnReturn
End Function
Private Function fncSendCommand(ByVal pCommand As String, Optional ByVal pPassword As String = "") As Boolean
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'サーバにコマンドを送信
'
' pCommand : 送信コマンド文字列
' pPassword : パスワード文字列
'
' 戻り値 : True:正常、False:異常
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim blnReturn As Boolean
Try
Me.subPutLog(">" & pCommand, pPassword)
'送信するコマンドをASCIIのバイト列に変換
pCommand = pCommand & ControlChars.CrLf
Dim bytCommand() As Byte = goEncASC.GetBytes(pCommand)
'コマンドを送信
goClient.Send(bytCommand, bytCommand.Length, Sockets.SocketFlags.None)
Threading.Thread.Sleep(250)
blnReturn = True
Catch ex As Exception
Me.fncMessageput(ex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
End Try
Return blnReturn
End Function
------------------------------------------------------------
Excelのアドレス形式を変換する方法(VBA＆VB.NET) [プログラミング]
VBAでExcelを操作しているとセルのアドレス形式をA1形式からR1C1形式に変換したい事が良くある。
そんなときにはExcelの"ConvertFormula"関数を利用すると簡単に変換できる。
この関数は基本的に数式に含まれるセルのアドレス形式を変換するための関数なのだが、実はアドレス文字列を変換する事もできる。
簡単なサンプルを書いてみるとこんな感じだ。
------------------------------------------------------------
Private Function fncChangeReferenceStyle(ByVal pValue As String, ByVal pFromStyle As XlReferenceStyle, ByVal pToStyle As XlReferenceStyle) As String
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'アドレス形式を変更
'
' pValue : 変更前アドレス形式の文字列
' pFromStyle : 変更前アドレス形式
' pToStyle : 変更後アドレス形式
'
' Result : 戻り値、変更後アドレス形式の文字列
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim strReturn As String
strReturn = Application.ConvertFormula(pValue, pFromStyle, pToStyle, xlAbsolute)
fncChangeReferenceStyle = strReturn
End Function
------------------------------------------------------------
上記のプロシージャに引数として「変換前のアドレス文字列」、「変換前アドレス形式」、「変換後アドレス形式」を渡してやると戻り値として「変換後のアドレス文字列」が返される。
つまり、変換前アドレス文字列に"B2"と渡して"R2C2"が返ってくるということ。
その逆に"R2C2"と渡して"B2"に変換する事も出来る。
上記はVBAの例だが、VB.NETの例は以下の通り
------------------------------------------------------------
Private Function fncChangeReferenceStyle(ByVal pValue As String, ByVal pFromStyle As Excel.XlReferenceStyle, ByVal pToStyle As Excel.XlReferenceStyle) As String
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'アドレス形式を変更
'
' pValue : 変更前アドレス形式の文字列
' pFromStyle : 変更前アドレス形式
' pToStyle : 変更後アドレス形式
'
' Result : 戻り値、変更後アドレス形式の文字列
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim strReturn As String
Dim objApp As Excel.Application = Nothing
Try
objApp = DirectCast(objExcel.Application, Excel.Application)
strReturn = objApp.ConvertFormula(pValue, pFromStyle, pToStyle, Excel.XlReferenceType.xlAbsolute).ToString
Catch comex As COMException
MsgBox(comex.Message, MsgBoxStyle.Exclamation)
strReturn = ""
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
strReturn = ""
End Try
Return strReturn
End Function
------------------------------------------------------------
さて、これだけじゃチョット面白くないのでもう一ひねり。
上記のプロシージャを使って文字列"B2"を"R2C2"に変換すると言う事は変換前はA1形式で変換後はR1C1形式だ。
逆に文字列"R2C2"を"B2"に変換すると言う事は変換前はR1C1形式で変換後はA1形式R1C1形式だ。
同様に列Bを列2に変換するためにはどうすれば良いかというと、文字列"B:B"を渡してやると文字列"C2"が返ってくる。
行の場合は文字列"2:2"を渡してやれば文字列"R2"が返ってくると言うわけだ。
残念な事に文字列"B"を渡して"C2"とか文字列"2"を渡して"R2"と言うわけには行かない。
また、文字列"C2"や"R2"をA1形式に変換すると返ってくる文字列は"$B:$B"や"$2:$2"と絶対参照の形式で返ってくるので注意が必要だ。
チョットした事だが、結構便利に使えるので何かの役に立てて貰えるだろうか…。
VB.NET で指定フォルダ(パス)以下のファイル、フォルダの変更を監視する方法 [プログラミング]
今回は特定のフォルダ(パス)に対してファイル、フォルダの変更を監視する方法を紹介しよう。
方法は至って簡単だ。"System.IO.FileSystemWatcher"クラスを利用することで指定したフォルダ(パス)以下のファイル、フォルダの変更が監視できる。
但し、その監視内容はそれほど厳密ではなく、短時間に多くの変更が発生した場合などはすべての変更が通知されるわけではない。
しかし、指定したフォルダ(パス)以下のファイル、フォルダに変更が発生したことは認識できるので処理を実行するきっかけにするには良いだろう。
以下の例ではフォームの「...」ボタンを押下して表示されるフォルダ選択ダイアログで監視対象のフォルダを選択した後、「監視開始」ボタンを押下すると指定したフォルダ(パス)以下にファイル、フォルダの変更が発生するとテキストボックスに「どのファイル/フォルダにどんな変更が発生したのか」が表示される。
今回は指定フォルダ内のサブフォルダも監視する設定にしているが、IncludeSubdirectoriesプロパティの値をFalseにすることでサブフォルダの監視を行わないことも可能である。
尚、「どのような変更が発生したか」とは言っても「作成、変更、名称変更」程度の情報しか知ることはできない。特に「変更」には「属性、サイズ、書込/アクセス時刻、アクセス許可」などがあるが、そのどれが発生したかまでは把握できない。
簡単にコードの説明をしよう。
・フォルダ監視の開始
ボタンの文字が「監視開始」の時にボタンを押下すると指定フォルダの監視を開始する。
1."System.IO.FileSystemWatcher"クラスの変数"gobjWatcher"を生成する。
2.生成した変数"gobjWatcher"の各プロパティを設定する。(Pathプロパティには監視対象のフォルダのフルパスを、NotifyFilterプロパティには監視対象とする変更イベント(今回は最終アクセス時刻、作成時刻、フォルダ名の変更、最終書込時刻、ファイル名の変更、サイズの変更を対象とした。)を、Filterプロパティには監視対象とするファイルの種類(今回はすべて"*.*"を対象とした。)を、IncludeSubdirectoriesプロパティにはサブフォルダの監視を行うか否か(前述した通り今回はTrueを指定。)を、SynchronizingObjectプロパティにはイベントを処理するオブジェクト(通常Windowsフォームを指定するので今回は"Me"とした。)を設定する。)
3.各プロパティの設定が完了したら、変更(Changed)、作成(Created)、削除(Deleted)、名称変更(Renamed)の各イベントを処理するイベントハンドラを追加する。尚、「変更/作成/削除」イベントは発生した際にイベントハンドラに渡されるパラメータのタイプが同じなので"Watcher_OnChanged"イベントハンドラで処理し、「名称変更」はそれらとパラメータが異なるため"Watcher_OnRenamed"イベントハンドラで処理する。
4.最後にEnableRaisingEventsプロパティの値にTrueを設定すると指定フォルダの監視が開始される。
・フォルダ監視の停止
ボタンの文字が「監視停止」の時にボタンを押下すると指定フォルダの監視を停止する。
1.フォルダ監視の開始で生成した変数"gobjWatcher"のEnableRaisingEventsプロパティの値にFalseを設定して指定フォルダの監視を停止する。
2.変数"gobjWatcher"のDisposeメソッドを実行してリソースを解放して終了だ。
・指定フォルダ以下の変更、作成、削除イベント発生時の処理
指定フォルダ(パス)以下に変更、作成、削除イベントが発生した際にイベントの発生したファイル、フォルダを認識してどのイベントが発生したのかを監視結果テキストボックスに編集する。
イベントの通知内容はどのイベントも同じだが、「変更/作成」と「削除」はイベント通知後の対処が異なるのでハンドラ内の処理を分けている。
まずは「変更/作成」のイベントの処理だ。
1."System.IO.FileSystemEventArgs"クラスのパラメータ"e"のChangeTypeプロパティの値が"IO.WatcherChangeTypes.Changed"(変更)または"IO.WatcherChangeTypes.Created"(作成)ならば処理を行う。
2.パラメータ"e"のFullPathプロパティに変更が通知されたファイル、フォルダの属性を判断するため"IO.FileInfo"クラスの変数"objInfo"に"FileIO.FileSystem"のGetFileInfoメソッドを実行してインスタンスを生成する。
3.変数"objInfo"のAttributesプロパティがフォルダ("IO.FileAttributes.Directory")でない場合(つまりファイルの場合)はそのファイルが使用中か否かを確認し、使用中の場合は以降の処理は行わない。
※サイズの大きいファイルをコピーした場合などはコピー開始時にファイルの作成が通知されるがその時点ではまだファイルは使用できる状態ではないので、コピーが完了するのを待って処理を行う必要があるためファイルが利用可能か否かを判断する。これを怠るとファイルが作成されたと思ってファイルを使おうとするとエラーが発生したり思わぬ処理結果になったりする。
※今回はファイルが使用中か否かを確認しているが使用が完了したか否かは確認していないため、イベント発生時に使用中のファイルについては監視結果テキストボックスにイベント発生が表示されない。フォルダ監視のアプリケーションを作成する際は使用中のみならず使用完了の確認も実装する必要がある。
尚、PC内でファイルを移動した際などは移動開始時点で移動先のファイルサイズが確定してしまうため「作成」のイベントしか発生しないが、FTP等でファイルを転送した際は転送開始時点でファイルサイズが確定しないため「作成」のイベント発生後もサイズ変更による「変更」のイベントが発生するのでそのイベントをきっかけに処理を行うことは可能である。
4.イベント発生内容を示す文言をパラメータ"e"のFullPathプロパティに変更が通知された対象がファイルの場合は「[ファイル名][発生したイベント文言]」とし、フォルダの場合は「サブフォルダ([フォルダ名])[発生したイベント文言]」として監視結果テキストボックスに追記する。
次は「削除」のイベント処理だ。
5."System.IO.FileSystemEventArgs"クラスのパラメータ"e"のChangeTypeプロパティの値が"IO.WatcherChangeTypes.Deleted"(削除)ならば処理を行う。
6.イベント発生内容を示す文言を「[ファイル名/フォルダ名]が削除されました。」として監視結果テキストボックスに追記する。
※「削除」イベントの場合は対象が既に削除されてしまっているため「ファイル/フォルダ」を判別することができない。
・指定フォルダ以下の名称変更イベント発生時の処理
指定フォルダ(パス)以下に名称変更イベントが発生した際にイベントの発生したファイル、フォルダを認識して監視結果テキストボックスに編集する。
1.パラメータ"e"のFullPathプロパティに変更が通知されたファイル、フォルダの属性を判断するため"IO.FileInfo"クラスの変数"objInfo"に"FileIO.FileSystem"のGetFileInfoメソッドを実行してインスタンスを生成する。
2.変数"objInfo"のAttributesプロパティがフォルダ("IO.FileAttributes.Directory")でない場合(つまりファイルの場合)はそのファイルが使用中か否かを確認し、使用中の場合は以降の処理は行わない。
※名称変更イベント発生時点でファイルが使用中と言うことは無いと思うが、おまじない的に使用中か否かの確認を行っている。確認しなくても多分問題ないはず…。
3.イベント発生内容を示す文言をパラメータ"e"のFullPathプロパティに変更が通知された対象がファイルの場合は「[変更前ファイル名]が[変更後ファイル名]に変更されました。」とし、フォルダの場合は「サブフォルダ([変更前フォルダ名])が[変更後フォルダ名]に変更されました。」として監視結果テキストボックスに追記する。
以下の例を実行するには、新規の「Windowsフォームアプリケーション」を作成しフォームのデザインで"TextBox"と"Button"コントロールを二つずつフォームに配置して、コードを"Form1"に貼り付けて実行すれば良い。
尚、一つ目の"TextBox"コントロールのNameプロパティには"txtPath"を設定し、二つ目の"TextBox"コントロールのMultilineプロパティにはTrueをNameプロパティには"txtResult"をScrollBarsプロパティにはVerticalを設定する。一つ目の"Button"コントロールのNameプロパティには"btnBrowse"をTextプロパティには"..."を設定し、二つ目の"Button"コントロールのNameプロパティには"btnWatch"を設定(Textプロパティは実行時に設定するのでデザイン時は設定不要)する。
プログラムを実行するとフォームが表示されるので、「...」ボタンを押下して監視するフォルダを選択し「監視開始」ボタンを押下して指定フォルダの監視を開始した後、エクスプローラで指定フォルダ内にファイルやフォルダを作成/削除/コピー/移動/名称変更等の操作をするとその結果が二つ目の"TextBox"コントロール(監視結果テキストボックス)に表示される。
色々操作をしているとイベント発生が表示されないイベントがあることに気付くだろう。この辺りの詳細は"FileSystemWatcher"クラスのヘルプを参照していただきたい。
------------------------------------------------------------
Public Class Form1
'定数宣言
Private Const CON_WATCH_START As String = "監視開始"
Private Const CON_WATCH_STOP As String = "監視停止"
'変数宣言
'フォルダ監視オブジェクト
Public gobjWatcher As System.IO.FileSystemWatcher = Nothing
'その他の変数
Private gstrLastPath As String = ""
Private Sub Form1_FormClosing(sender As Object, _
e As System.Windows.Forms.FormClosingEventArgs) _
Handles Me.FormClosing
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'フォームが閉じようとしている時の処理
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'フォルダ監視オブジェクトを破棄
If Not IsNothing(gobjWatcher) Then
Call subStopFolderWatch()
End If
End Sub
Private Sub Form1_Load(sender As Object, _
e As System.EventArgs) _
Handles Me.Load
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'フォームロード時の処理
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Me.Text = "フォルダ監視テスト"
btnWatch.Text = CON_WATCH_START
gstrLastPath = Application.StartupPath
'各種コントロールの動作設定
Call subControlSet()
End Sub
Private Sub btnBrowse_Click(sender As Object, _
e As System.EventArgs) _
Handles btnBrowse.Click
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'フォルダ参照ボタン押下時の処理
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim strSelectPath As String = ""
Dim strInitPath As String = gstrLastPath
'初期表示フォルダを設定
With txtPath
If .Text.Trim <> "" Then
'パスが選択済みの場合、現在のパスを設定
strInitPath = .Text.Trim.ToString
End If
End With
'フォルダ参照ダイアログボックスを表示
If fncShowBrowseFolder( _
"監視するフォルダを指定してください。", _
strInitPath, False, strSelectPath) _
= DialogResult.OK Then
'フォルダが指定された場合、選択されたフォルダのパスを入力ファイル格納場所テキストボックスに設定
txtPath.Text = strSelectPath
gstrLastPath = strSelectPath
End If
'各種コントロールの動作設定
Call subControlSet()
End Sub
Private Sub btnWatch_Click(sender As Object, _
e As System.EventArgs) _
Handles btnWatch.Click
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'監視ボタン押下時の処理
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
If btnWatch.Text = CON_WATCH_START Then
'監視結果テキストボックスの内容を初期化
txtResult.Clear()
'監視ボタンの文字が監視開始の場合、指定フォルダの監視を開始
Call subStartFolderWatch(txtPath.Text)
'監視ボタンの文字を監視停止に変更
btnWatch.Text = CON_WATCH_STOP
Else
'監視ボタンの文字が監視停止の場合、指定フォルダの監視を停止
Call subStopFolderWatch()
'監視ボタンの文字を監視開始に変更
btnWatch.Text = CON_WATCH_START
End If
'各種コントロールの動作設定
Call subControlSet()
End Sub
Private Function fncFileUsing( _
ByVal pFullPath As String) As Boolean
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'指定ファイルが使用中か否かを確認
'
' pFullPath : 確認するファイルのフルパス
'
' Result : 戻り値、True:使用中、False:未使用
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim blnReturn As Boolean
Dim objFileStream As IO.FileStream = Nothing
Dim objFileInfo As IO.FileInfo = _
New IO.FileInfo(pFullPath)
Try
objFileStream = objFileInfo.OpenRead
objFileStream.Close()
objFileStream.Dispose()
objFileStream = Nothing
blnReturn = False
Catch ex As Exception
'エラーが発生した場合、指定ファイルは使用中
blnReturn = True
Finally
If Not IsNothing(objFileStream) Then
objFileStream.Close()
objFileStream.Dispose()
objFileStream = Nothing
End If
If Not IsNothing(objFileInfo) Then
objFileInfo = Nothing
End If
End Try
Return blnReturn
End Function
Private Function fncShowBrowseFolder( _
ByVal pDescription As String, _
ByVal pInitPath As String, _
ByVal pShowNewFolder As Boolean, _
ByRef pSelectPath As String) _
As DialogResult
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'フォルダ参照ダイアログの表示
'
' pDescription ： ダイアログボックスのコメント文
' pInitPath ： 初期表示フォルダのパス
' pShowNewFolder ： 新しいフォルダ作成ボタン表示判定
' pSelectPath ： 選択されたフォルダのパス
'
' Result ： 戻り値、ダイアログの戻り値
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim objFolderBrowser As FolderBrowserDialog
Dim objResult As DialogResult
'フォルダ参照ダイアログボックスのインスタンスを作成
objFolderBrowser = New _
System.Windows.Forms.FolderBrowserDialog
'フォルダ参照ダイアログボックスを設定
With objFolderBrowser
.Description = pDescription
If pInitPath <> "" Then
.SelectedPath = pInitPath
Else
.SelectedPath = _
Environment.GetFolderPath( _
Environment.SpecialFolder _
.Personal).ToString
End If
.ShowNewFolderButton = pShowNewFolder
End With
'フォルダ参照ダイアログボックスを表示
objResult = objFolderBrowser.ShowDialog
If objResult = DialogResult.OK Then
pSelectPath = _
objFolderBrowser.SelectedPath
End If
objFolderBrowser.Dispose()
'戻り値の設定
Return objResult
End Function
Private Sub subControlSet()
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'各種コントロールの動作設定
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'監視対象パス
txtPath.Enabled = True
If btnWatch.Text = CON_WATCH_STOP Then
'監視ボタンの文字が監視停止の場合
btnBrowse.Enabled = False
Else
'監視ボタンの文字が監視開始の場合
btnBrowse.Enabled = True
End If
'監視ボタン
If txtPath.Text.Trim = "" Then
'監視対象パスが未指定の場合
btnWatch.Enabled = False
Else
'監視対象パスが指定済の場合
btnWatch.Enabled = True
End If
'監視結果
If btnWatch.Text = CON_WATCH_START Then
'監視ボタンの文字が監視開始の場合
txtResult.Enabled = False
Else
'監視ボタンの文字が監視停止の場合
txtResult.Enabled = True
End If
End Sub
Private Sub subEditResult(ByVal pComment As String)
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'監視結果をテキストボックスに追記
'
' pComment ： ファイル変更状態文言
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim stbText As System.Text.StringBuilder = _
New System.Text.StringBuilder(txtResult.Text)
If txtResult.Text.Trim <> "" Then
'テキストが既に記入済の場合、改行コードを追記
stbText.Append(ControlChars.CrLf)
End If
'監視結果を追記
stbText.Append(pComment)
txtResult.Focus()
txtResult.Text = stbText.ToString
txtResult.SelectionStart = txtResult.Text.Length
txtResult.ScrollToCaret()
End Sub
Private Sub subStartFolderWatch(ByVal pPath As String)
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'指定フォルダの変更の監視を開始
'
' pPath ： 監視対象フォルダのパス
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
If Not IsNothing(gobjWatcher) Then
'フォルダ監視オブジェクトが存在する場合は処理終了
Exit Sub
End If
'フォルダ監視オブジェクトを生成
gobjWatcher = New System.IO.FileSystemWatcher
'フォルダ監視オブジェクトを設定
With gobjWatcher
'監視対象のパスを設定
.Path = pPath
'監視対象のイベント設定(アクセス日時、作成日時、フォルダ名の変更、更新日時、ファイル名の変更、サイズ変更を監視)
.NotifyFilter = _
IO.NotifyFilters.LastAccess Or _
IO.NotifyFilters.CreationTime Or _
IO.NotifyFilters.DirectoryName Or _
IO.NotifyFilters.LastWrite Or _
IO.NotifyFilters.FileName Or _
IO.NotifyFilters.Size
'監視対象ファイルを設定(すべてのファイル)
.Filter = "*.*"
'サブフォルダの監視を行わないに設定
.IncludeSubdirectories = True
'イベントを受け取るオブジェクトを設定
.SynchronizingObject = Me
'イベントハンドラを追加
AddHandler .Changed, _
AddressOf Watcher_OnChanged '変更時
AddHandler .Created, _
AddressOf Watcher_OnChanged '作成時
AddHandler .Deleted, _
AddressOf Watcher_OnChanged '削除時
AddHandler .Renamed, _
AddressOf Watcher_OnRenamed '名称変更時
'監視の開始
.EnableRaisingEvents = True
End With
End Sub
Private Sub subStopFolderWatch()
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'指定フォルダの変更の監視を停止
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'監視を停止
gobjWatcher.EnableRaisingEvents = False
'フォルダ監視オブジェクトを破棄
gobjWatcher.Dispose()
gobjWatcher = Nothing
End Sub
Private Sub subTargetCheck( _
ByVal e As System.IO.FileSystemEventArgs, _
ByVal pBasePath As String, _
ByRef pComment As System.Text.StringBuilder)
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'通知された対象を解析
'
' e ： 通知されたイベントパラメータ
' pBasePath ： 解析の基準フォルダのパス
' pComment ： 監視結果への表示内容
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim objInfo As IO.FileInfo = _
FileIO.FileSystem.GetFileInfo(e.FullPath)
If objInfo.Attributes <> _
IO.FileAttributes.Directory Then
'通知対象がファイルの場合
'ファイルが使用中か否かを判定
If fncFileUsing(e.FullPath) Then
'ファイルが使用中の場合、処理終了
pComment.Clear()
Exit Sub
End If
'監視結果への表示内容を編集
pComment.Append(e.Name)
Else
'通知対象がフォルダの場合
'監視結果への表示内容を編集
pComment.Append("サブフォルダ(" & e.Name & ")")
End If
End Sub
Private Sub Watcher_OnChanged( _
ByVal source As System.Object, _
ByVal e As System.IO.FileSystemEventArgs)
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'指定フォルダに変更、作成、削除イベント発生時の処理
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim stbComment As System.Text.StringBuilder = _
New System.Text.StringBuilder
Select Case e.ChangeType
Case IO.WatcherChangeTypes.Changed, _
IO.WatcherChangeTypes.Created
'変更、作成、名称変更が発生した場合
Call subTargetCheck( _
e, txtPath.Text, stbComment)
If stbComment.ToString = "" Then
Exit Sub
End If
If e.ChangeType = _
IO.WatcherChangeTypes.Changed Then
'ファイルが変更された場合
stbComment.Append( _
"に変更が発生しました。")
Else
'ファイルが作成された場合
stbComment.Append("が作成されました。")
End If
'対象ファイルの情報を監視結果テキストボックスに追加
Call subEditResult(stbComment.ToString)
Case IO.WatcherChangeTypes.Deleted
'削除が発生した場合
stbComment.Append(e.Name)
stbComment.Append("が削除されました。")
'対象ファイルの情報を監視結果テキストボックスに追加
Call subEditResult(stbComment.ToString)
End Select
End Sub
Private Sub Watcher_OnRenamed(source As Object, _
e As System.IO.RenamedEventArgs)
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'指定フォルダに名称変更イベント発生時の処理
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim stbComment As System.Text.StringBuilder = _
New System.Text.StringBuilder
Dim objFileInfo As IO.FileInfo = _
FileIO.FileSystem.GetFileInfo(e.FullPath)
If objFileInfo.Attributes <> _
IO.FileAttributes.Directory Then
'通知対象がファイルの場合
If fncFileUsing(e.FullPath) Then
'ファイルが使用中の場合、処理終了
Exit Sub
End If
stbComment.Append(e.OldName & "が")
Else
'通知対象がフォルダの場合
stbComment.Append("サブフォルダ(" & _
e.OldName & ")が")
End If
'対象ファイルの変更後情報を監視結果テキストボックスに追加
stbComment.Append(e.Name & _
"に変更されました。")
Call subEditResult(stbComment.ToString)
End Sub
End Class
------------------------------------------------------------
VB.NET でデータベースを操作する方法 [プログラミング]
今回はVB.NETでデータベースを操作する方法を紹介する。
データベースには利用しやすいAccessを使用するが、お使いのパソコンにMicrosoftのOfficeソフトがインストールされていればAccessがインストールされている必要はないはずである…。
基本的にデータベースの操作はADO.NETで行うため特別な参照を追加する必要はないのだが、ADO.NETにはデータベースを新規作成する機能がないのでそのためだけに"ADOX"の参照を追加している。
"ADOX"を利用するには「プロジェクト→参照の追加 COMタブより"Microsoft ADO Ext. x.x for DDL and Security"を追加」を行い、コードに"ADOX"のインポートが必要である。
＜2014/6/30 追記＞
参照の追加で"Microsoft ActiveX Data Objects x.x Library"を追加する。※”ADODB"のインポートは行わない。(コード上、ADODBの利用が判るように…。)
これはADOXでデータベースを作成した後、ADODBを使用して作成したデータベースへの接続を切断するのに使用する。
当初のコードで紹介した方法では、切断したように見えて切断できていなかった。
今回紹介するデータベース操作の大まかな内容は以下の通り。
1.空のデータベースを新規作成する。
2.データベースにテーブルを新規作成する。
3.テーブルにインデックスを作成する。
4.データベースに作成されたテーブルとそのフィールド、インデックスの内容を確認する。
5.テーブルにデータをインポートする。
6.テーブルよりデータを抽出してExcelに編集する。
各処理を簡単に説明しよう。
1.データベースの新規作成
今回使用するデータベースはアプリケーションの実行パスに"TestSchool.accdb"というファイル名で作成する。※お使いのOfficeソフトが2003以前の場合は拡張子は".mdb"とする。
・まずデータベースの接続文字列を設定するのだが、これもOfficeソフトのバージョンによって適宜読み替えて欲しい。接続文字列には"Provider=Microsoft.ACE.OLEDB.xx.x;Data Source=[データベースのフルパス]"を設定する。("xx.xx"には適切なバージョン番号を入れる。)
・次に空のデータベースカタログ(これが"ADOX"のオブジェクト)を作成し、作成したデータベースカタログのCreateメソッド(引数はデータベース接続文字列)を実行して空のデータベースを新規作成する。・そしてデータベースコネクションのインスタンスを作成(データベース接続文字列は先ほどと同様)し、データベースコネクションのCloseメソッドを実行して作成したデータベースを閉じる。
＜2014/6/30 修正＞
・そしてADODBのデータベースコネクションのインスタンスを作成(データベースカタログのActiveConnectionプロパティを設定。※データベース接続文字列を用いても良い。)し、データベースコネクションのCloseメソッドを実行して作成したデータベースを閉じる。
※この時点で"TestSchool.laccdb"(データベースのロックファイル)が削除される。
これでテーブルも何もない空のデータベースが作成される。
※わざわざ参照を追加した"ADOX"の出番はこれで終了。＜2014/6/30 追記＞"ADODB"の出番も終了。
※ここで利用したデータベースカタログはCOMオブジェクトなので、COMオブジェクトの参照カウントをデクリメントする必要がある。＜2014/6/30 追記＞"ADODB"もCOMオブジェクトなので参照カウントのデクリメントが必要。
2.データベースにテーブルを新規作成
新規作成したデータベースには一つもテーブルが存在しない状態である。ここにコマンドオブジェクトを使用してSQLでテーブルの作成を行う。
サンプルコードではデータベースに作成するテーブル名、各テーブルのフィールド情報、インデックス情報およびインサートするデータを配列変数に定義しているので、この中のテーブル名、フィールド情報を使用してテーブルを作成する。
この処理はテーブル名配列("gstrTblName")を順次参照してテーブル名に該当するフィールド情報配列("gobj[xxxx]Item")からフィールド情報を取得してテーブル作成のSQLを生成している。
・SQLを生成するための変数として"System.Text.StringBuilder"型の"stbSql"を宣言し、"CREATE TABLE [テーブル名] ("で初期化する。
※変数を"String"型とせず"System.Text.StringBuilder"型としたのは、この後フィールド情報配列からSQL文字列を生成する際に文字列の追加を容易にするためである。
------------------------------------------------------------
Dim stbSql As System.Text.StringBuilder = _
New System.Text.StringBuilder("CREATE TABLE " & _
gstrTblName(i) & " (")
'フィールド名を追加する場合は以下の構文でOK
stbSql.Append(objItem(j, 0).ToString)
'変数がテキスト型の場合は以下の構文になる
strSql = strSql & objItem(j, 0).ToString
------------------------------------------------------------
・フィールド情報配列を順次参照して変数"stbSql"に「[フィールド名] [データ型]{[サイズ]}」をAppendメソッドで追加していく。(サイズはフィールドのデータ型がテキスト型の場合のみ指定する。)
・フィールド定義の追加が終わったら最後に「);」を追加してSQLの完成である。
・生成したSQLを実行するため"OleDbCommand"型のオブジェクト変数"objCmd"を宣言し、生成したSQLとデータベース接続文字列(前述と同様)で初期化する。
・変数"objCmd"のExecuteNonQueryメソッドを実行すればデータベースにSQLで指定した内容のテーブルが作成される。
サンプルコードではデータベースに「学級、科目、教師、生徒、成績」の五つのテーブルを作成している。
3.テーブルにインデックスを作成
テーブルにインデックスを設定しなくてもテーブルからデータの抽出は行えるがデータ量が多い場合は適切なインデックスの設定の有無で処理速度が大幅に変わってくるので、テーブルを作成したらデータの抽出にあったインデックスを設定しておこう。
インデックスの作成もテーブルの作成と同様にコマンドオブジェクトを使用してSQLを実行する。
この処理もテーブル名配列("gstrTblName")を順次参照してテーブル名に該当するインデックス情報配列("gobj[xxxx]Index")からインデックス情報を取得してインデックス作成のSQLを生成している。
・SQLを生成するための変数として"System.Text.StringBuilder"型の"stbSql"を宣言する。(テーブル作成の際と初期化のタイミング方法が異なるが、処理の都合上で特に他意はない。)
・変数"stbSql"を初期化した後、Appendメソッドで「CREATE INDEX [インデックス名] ON [テーブル名] ("」を追加する。
・その後、インデックス情報配列を順次参照してインデックスを構成するフィールド名を変数"stbSql"に「[インデックス名]」追加していく。
・インデックスを構成するフィールド名の追加が終わったら最後に「);」を追加してSQLの完成である。
・変数"objCmd"のExecuteNonQueryメソッドを実行すればデータベースにSQLで指定したテーブルに指定した内容のインデックスが作成される。
4.データベースに作成されたテーブルとそのフィールド、インデックスを確認
自アプリケーションでデータベースにテーブル、フィールドおよびインデックスを作成した場合は作成内容が明らかなので特に確認する必要はないが、アプリケーションが既存のデータベースを利用する場合などにはそのデータベースにどんなテーブルが存在するのか、テーブルにはどんなフィールド、インデックスが存在するのかを知る必要が出てくる場合がある。そのような時のためにテーブル、フィールド、インデックスの確認方法を紹介しておこう。
・データベースのテーブル情報を確認するにはデータベースコネクション("OleDbConnection")オブジェクトのGetOleDbSchemaTableメソッドを利用してスキーマテーブルからテーブル情報を取得する。
テーブル情報を取得するにはGetOleDbSchemaTableメソッドの第一引数に定数"OleDbSchemaGuid.Tables"を指定し第二引数に該当する制約を指定する。第二引数に指定する制約の内容は"OleDbSchemaGuid"型の定数の指定によって異なるのでヘルプ等を参照して内容を確認してほしい。
今回は第一引数に"OleDbSchemaGuid.Tables"を指定してテーブル情報を取得するので制約は「{[TABLE_CATALOG], [TABLE_SCHEMA], [TABLE_NAME], [TABLE_TYPE]}」であり実際の指定内容は「{Nothing, Nothing, Nothing, "TABLE"}」となる。
GetOleDbSchemaTableメソッドを実行して得られる戻り値は"DataTable"型のオブジェクトなので、以下の通り変数"objTables"に戻り値を受け取るよう宣言する。
------------------------------------------------------------
Dim objTables As DataTable = _
gobjDbCon.GetOleDbSchemaTable(OleDbSchemaGuid.Tables, _
New Object() {Nothing, Nothing, Nothing, "TABLE"})
------------------------------------------------------------
・次に取得したデータテーブルからテーブル情報を取得するのだが、テーブル情報はデータテーブルのRowsプロパティに"DataRow"型のオブジェクトとして格納されているのでテーブルからデータを読み出す要領で内容を参照する。
※しかし問題は"DataRow"にどんなフィールドがあり何が格納されているのかが判らないと言うことだ。これはヘルプを参照しただけでは知ることはできないが、"http://msdn.microsoft.com/ja-jp/library/cc407988.aspx"(MSDNのサイト)で知ることができる。
・前述のサイトから「TABLES行セット」を探すと"DataRow"に"TABLE_NAME"フィールドがありテーブル名が格納されていることが判るので、取得した変数"objTables"のRowsプロパティを順次参照して"TABLE_NAME"フィールドの値を取得すればデータベースに定義されたテーブル名を確認できる。
------------------------------------------------------------
'取得したデータテーブルのレコードから"TABLE_NAME"列の値を取得
ReDim pTableName(objTables.Rows.Count - 1)
For i As Integer = 0 To objTables.Rows.Count - 1
pTableName(i) = objTables.Rows(i)("TABLE_NAME").ToString
Next
------------------------------------------------------------
テーブル内のフィールド情報を取得する場合もテーブル情報を取得する場合と同様にデータベースコネクションのGetOleDbSchemaTableメソッドで可能だが、今度は別の方法で取得してみよう。
・"OleDbCommand"型のオブジェクト変数"objCmd"を宣言し、テーブルからデータを抽出するSQL「SELECT * FROM [テーブル名];」とデータベース接続文字列(前述と同様)で初期化する。
・変数"objCmd"のExecuteReaderメソッドを使用して"OleDbDataReader"型のオブジェクト変数"objRd"を生成する。
・続いて変数"objRd"のGetSchemaTableメソッドでデータリーダーのスキーマテーブルを"DataTable"型のオブジェクト変数"objDt"に取得する。
※GetSchemaTableメソッドで取得したデータテーブルに含まれる"DataRow"のフィールド情報はGetSchemaTableメソッドのヘルプで確認できる。
・今度は取得した変数"objDt"のRowsプロパティから"DataRow"を順次読み出してフィールドの内容を確認する。1番目のフィールド("ColumnName")からは「フィールド名」、2番目のフィールド("ColumnOrdinal")からは「フィールド番号」、3番目のフィールド("ColumnSize")からは「サイズ」、6番目のフィールド("DataType")からは「データタイプ」が取得できる。(フィールドの値をインデックスを指定して取得する場合は0から始まるので1番目のフィールド("ColumnName")の場合は0を指定する。)
------------------------------------------------------------
'データリーダーで指定テーブルを取得
Using objRd As OleDbDataReader = objCmd.ExecuteReader
'データリーダーのスキーマテーブルを取得
Using objDt As DataTable = objRd.GetSchemaTable
'取得したデータテーブルのレコードから
'"ColumnOrdinal"列(2番目の列)、"ColumnName"列(1番目の列)、
'"DataType"列(6番目の列)、"ColumnSize"列(3番目の列)を取得
For Each objDr As DataRow In objDt.Rows
Dim strMsg As String = _
"<フィールド" & objDr(1).ToString & ">" & _
" 名称：" & objDr(0).ToString & _
"、タイプ：" & objDr(5).ToString
Dim objType As Type = GetType(System.String)
If objDr(5).Equals(objType) Then
'タイプがStringの場合、サイズを取得
strMsg = strMsg & _
"、サイズ：" & objDr(2).ToString
End If
Call subPutConsoleMsg(strMsg)
Next
End Using
'データリーダーをクローズ
objRd.Close()
End Using
------------------------------------------------------------
※テーブル名を取得する場合と比べてデータテーブルからの取得方法が異なるがやっていることはどちらも同じだ。
最後にテーブルに設定されたインデックス情報の取得ですが、取得方法はテーブル情報と同様にデータベースコネクションオブジェクトのGetOleDbSchemaTableメソッドを利用してスキーマテーブルから取得します。
・インデックス情報を取得するために第一引数に設定するのは定数"OleDbSchemaGuid.Indexes"で第二引数の制約は「{[TABLE_CATALOG], [TABLE_SCHEMA], [INDEX_NAME], [TYPE], [TABLE_NAME]}」なので「{Nothing, Nothing, Nothing, Nothing, [テーブル名]}」となる。
テーブル情報と同様に戻り値を"DataTable"型のオブジェクト変数"objIndexes"に受け取るよう宣言する。
これで変数"objIndexes"のRowsプロパティより指定したテーブルのインデックス情報を読み取ることが可能なのだが、前述のMSDNサイトの「INDEXES行セット」の内容を見ると"DataRow"にはインデックスを構成するフィールド毎に情報が格納されていることが判る。つまり単純にRowsプロパティを順次読み込みするとテーブルに指定されたすべてのインデックス情報が読み出されることになる。できればインデックス毎に情報を整理したい。
もう一度GetOleDbSchemaTableメソッドに指定する第二引数を確認すると制約の中に「[INDEX_NAME]」がある。つまりインデックス名とテーブル名を制約に指定すれば指定したテーブルの指定したインデックスを構成するフィールド情報のみを読み込むことができる。
と言うことでまずはテーブル名だけを指定してGetOleDbSchemaTableメソッドを実行し、取得したインデックス情報からインデックス名が一意となるように配列に格納する。
・作成したインデックス名配列より順次インデックス名を設定してGetOleDbSchemaTableメソッドを実行するとインデックス毎にフィールド情報が確認できる。17番目のフィールド("ORDINAL_POSITION")からは「フィールド番号」、18番目のフィールド("COLUMN_NAME")からは「フィールド名」が取得できる。
5.テーブルにデータをインポート
前述した通りサンプルコードではインポートするデータも配列変数として宣言しているので、本サンプルではこの配列変数からデータを各テーブルにインポートする。実用アプリケーションではCSV形式のファイルを読み込んでデータをインポートするケースが多々あると思うが、本サンプルの配列の1要素が読み込んだCSVファイルの1レコードと解釈してほしい。
サンプルコードでは配列を順次参照してインポートのSQLを生成しコマンドオブジェクトを利用してSQLを実行しているが、イメージはファイルを順次読み込んで処理しているのと同様である。
・SQLを生成するための変数として"System.Text.StringBuilder"型の"stbSql"、"stbFd"、"stbVal"を宣言する。変数"stbSql"はSQLの主となる部分で「INSERT INTO [テーブル名]」で初期化する。変数"stbFd"はSQLのフィールド定義の部分で「 (」で初期化する。変数"stbVal"はSQLのフィールドの値の部分で「 VALUES(」で初期化する。
SQLの変数を三つに分けている(厳密には二つ("stbSql"と"stbFd"は分けなくても構わない)で良い)のには理由がある。データをインポートする際は読み込んだレコード毎にSQLを生成する必要があるためフィールドの値のみが異なるSQLを何度も生成することになる。上手にコーディングすればループ処理でSQLの生成は簡単にコーディングできるのでコーディングの手間は削減できるが、アプリケーションを実行した際には同じSQLの生成処理が何度も繰り返されるのでSQL生成の手間は削減できていないことになる。
そこで本サンプルではSQL内の「フィールドの値」を設定する部分をコマンドオブジェクトのParametersプロパティを使用してアプリケーション実行時のSQL生成の手間を削減している。そのためにフィールドの値にあたる変数"stbVal"は別に宣言しているのだ。
・基本となるSQLを生成するためフィールド情報配列("gobj[xxxx]Item")を順次参照して変数"stbFd"には「フィールド名」を、変数"stbVal"には「@Item[n]」を追加する。最後に変数"stbSql"に「変数"stbFd"＋")"」と「変数"stbVal"＋");"」を追加し、変数"objCmd"を宣言して変数"stbSql"とデータベース接続文字列(前述と同様)で初期化する。
・次はデータ情報配列("gobj[xxxx]Data")を順次参照してテーブルにデータをインポートする。データ情報配列は「(行,列)」の二次元配列になっているのでこの処理をCSVファイルの読み込みに置き換えた場合は読み込んだレコードを区切り文字でSplitして一次元配列に格納してから処理すると思えば良いだろう。
・コマンドオブジェクトのParametersプロパティをClearメソッドで初期化した後、データ情報配列の二次元目(列)を順次参照してコマンドオブジェクトのParametersプロパティにAddメソッドで「@Item[n]」と「データタイプ」を追加してから追加したParametersプロパティの要素のValueプロパティにデータ情報配列から参照した値を設定する。
・コマンドオブジェクトのParametersプロパティの設定が終了したらExecuteNonQueryメソッドで生成したSQLを実行してデータをインポートする。
・データをすべてインポートし終えたら"SELECT COUNT(*) FROM [テーブル名];"のSQLで初期化したコマンドオブジェクトでデータリーダーを生成して、テーブルのレコード件数がインポートしたデータ件数と一致することを確認する。
※本サンプルではコマンドオブジェクトに渡すパラメータを「@Item[n]」として「名前付きパラメータ」のように表現しているが、コマンドオブジェクトのCommandTypeプロパティが"Text"(規定値)の場合はOLE DB .NETプロバイダーでは「名前付きパラメータ」を使用することはできない。本来はプレースホルダーとして疑問符("?")を指定すべきだが「@Item[n]」でもプレースホルダーの役割を果たすことができるし見た目も判りやすいので敢えて疑問符を使用していない。
※本サンプルではインポートするデータ量が少ないのでコマンドパラメータを使用したことでの処理性能は評価できないが、大量データをインポートする場合には多少なりとも処理性能の向上には貢献できるはずだ。
6.テーブルよりデータを抽出してExcelに編集する(1)
まずはテーブルに格納されたデータから「学年、学級」毎に生徒の情報を抽出し、抽出した結果をExcelシートに編集する。
「学年、学級」の情報は「学級テーブル」から、生徒の「氏名、性別、生年月日」は「生徒テーブル」から取得する。本サンプルで使用しているSQLは一例なので別のSQLで処理を実現しても構わない。
・「学年、学級」毎に処理を行うためString型の変数"strClsSql"に「SELECT * FROM 学級 ORDER BY 学年, 学級;」のSQLを生成し、Excelシートに編集するデータを抽出するためString型の変数"strStdSql"に「SELECT C.学年, C.学級, S.氏名_姓, S.氏名_名, S.性別, S.生年月日 FROM 学級 AS C, 生徒 AS S WHERE S.学級_NO = @ClassNo AND C.ROW_NO = S.学級_NO ORDER BY S.生年月日;」のSQLを生成する。(今回もコマンドパラメータを使用して変数"strStdSql"のSQLの「@Class」を順次書き換えていく。)
・"OleDbCommand"型のオブジェクト変数"objClsCmd"と"objStdCmd"を宣言し、前者は変数"strClsSql"で後者は変数"strStdSql"で初期化する。
・変数"objStdCmd"のParametersプロパティをClearメソッドで初期化した後、変数"objClsCmd"のExecuteReaderメソッドを実行して"OleDbDataReader"型のオブジェクト変数"objClsRd"を生成する。
・変数"objClsRd"のReadメソッドで抽出した「学級テーブル」のレコードを順次読み出し、変数"objStdCmd"のParametersプロパティに読み込んだレコードの"ROW_NO"フィールドの値を設定する。
・コマンドパラメータを設定し終えた変数"objStdCmd"のExecuteReaderメソッドを実行して"OleDbDataReader"型のオブジェクト変数"objRd"を生成する。このデータリーダーはExcelシートに編集する際の項目ヘッダーを編集するために実行したSQLで取得したデータソースのフィールド名を取得するために使用する。フィールド名の取得方法は前述した方法なので割愛するが、取得したフィールド名は"Object"型の配列変数"objCol"に順次格納し、最後に"Object"型の配列変数"objRow"の先頭要素に格納する。(配列変数"objRow"は一次元配列として宣言しているが、配列変数"objCol"を格納した時点で二段階配列となる。)
・次は実際の生徒の情報を読み込む。まずは"OleDbDataAdapter"型のオブジェクト変数"objDa"を宣言して変数"objStdCmd"で初期化し、"DataTable"型のオブジェクト変数"objDt"を宣言してテーブル名「Student」で初期化した後、変数"objDa"のFillメソッドで変数"objDt"にデータを読み込む。
・抽出したデータの内容は変数"objDt"のRowsプロパティを順次読み出して"DataRow"のItemArrayプロパティの値を配列変数"objRow"に格納する。
・上記の手順で変数"strStdSql"に指定した内容で抽出したデータのフィールド名と各レコードのフィールドの値を配列変数"objRow"に格納し終えたら、別途「VB.NETで配列の内容をExcelに一括編集する方法」で説明した方法で配列変数"objRow"を二段階配列→二次元配列に変換(配列(行)(列)→配列(列,行)→配列(行,列))してExcelシートに一括編集する。
・変数"objClsRd"に抽出したすべての学級データに対して生徒の情報を各Excelシートに編集し終えたら、変数"objClsRd"のCloseメソッドを実行してデータリーダーを閉じて処理終了だ。
7.テーブルよりデータを抽出してExcelに編集する(2)
次は先ほど「学年、学級」毎に生徒の情報を編集したExcelシートに各生徒の一学期、二学期の各教科の成績を追加編集する。
「学年、学級」の情報は「学級テーブル」から、生徒の「氏名、生年月日」は「生徒テーブル」から、生徒毎の「科目、学期、得点」の情報は「成績テーブル」から取得する。
※今回はテーブル間のリレーションを利用したデータの取得を行うが、リレーションの利用方法を説明するためなので一部はリレーション可能な操作を割愛している。
・「学年、学級」の情報は先ほど生成した変数"strClsSql"をそのまま流用する。生徒の情報は先ほどExcelシートに「生年月日」順に編集したのでString型の変数"strStdSql"に「SELECT * FROM 生徒 ORDER BY 生年月日;」のSQLを生成する。
・一学期の各科目の得点情報はString型の変数"strTrm1Sql"に「SELECT J.生徒_NO, J.得点, M.得点, E.得点, J.得点 + M.得点 + E.得点 AS 合計 FROM (SELECT * FROM 成績 WHERE 学期 = 1 AND 科目_NO = 1) AS J, " & "(SELECT * FROM 成績 WHERE 学期 = 1 AND 科目_NO = 2) AS M, (SELECT * FROM 成績 WHERE 学期 = 1 AND 科目_NO = 3) AS E " & "WHERE J.生徒_NO = M.生徒_NO AND J.生徒_NO = E.生徒_NO ORDER BY J.生徒_NO;」のSQLを生成する。
・二学期の各科目の得点情報はString型の変数"strTrm2Sql"に「SELECT J.生徒_NO, J.得点, M.得点, E.得点, J.得点 + M.得点 + E.得点 AS 合計 FROM (SELECT * FROM 成績 WHERE 学期 = 2 AND 科目_NO = 1) AS J, " & "(SELECT * FROM 成績 WHERE 学期 = 2 AND 科目_NO = 2) AS M, (SELECT * FROM 成績 WHERE 学期 = 2 AND 科目_NO = 3) AS E " & "WHERE J.生徒_NO = M.生徒_NO AND J.生徒_NO = E.生徒_NO ORDER BY J.生徒_NO;」のSQLを生成する。
・"DataSet"型のオブジェクト変数"objDs"、"OleDbDataAdapter"型のオブジェクト変数"objClsDa"、"objStdDa"、"objT1RcdDa"、"objT2RcdDa"をそれぞれ宣言し、データアダプタは順に変数"strClsSql"、"strStdSql"、"strTrm1Sql"、"strTrm2Sql"で初期化する。
・変数"objClsDa"、"objStdDa"、"objT1RcdDa"、"objT2RcdDa"に対してそれぞれFillメソッドを実行して変数"objDs"に"CLASS"、"STUDENT"、"T1_RECORD"、"T2_RECORD"のテーブル名で読み込みを行う。
・ここまででそれぞれのテーブルから抽出したデータの準備ができたのでいよいよリレーションの設定を行う。
まずは「学級テーブル("CLASS")」のフィールド"ROW_NO"と「生徒テーブル("STUDENT")」のフィールド"学級_NO"をリレーション"CS_REL"として変数"objDs"のRelationsプロパティに追加し、「生徒テーブル("STUDENT")」のフィールド"ROW_NO"と「一学期の成績テーブル("T1_RECORD")」、「二学期の成績テーブル("T2_RECORD")」のフィールド"生徒_NO"をそれぞれリレーション"ST1_REL"、"ST2_REL"として変数"objDs"のRelationsプロパティに追加する。以下がその例だ。
------------------------------------------------------------
'データセットにテーブル間のリレーションを設定
objDs.Relations.Add( _
"CS_REL", objDs.Tables("CLASS").Columns("ROW_NO"), _
objDs.Tables("STUDENT").Columns("学級_NO"))
objDs.Relations.Add( _
"ST1_REL", objDs.Tables("STUDENT").Columns("ROW_NO"), _
objDs.Tables("T1_RECORD").Columns("生徒_NO"))
objDs.Relations.Add( _
"ST2_REL", objDs.Tables("STUDENT").Columns("ROW_NO"), _
objDs.Tables("T2_RECORD").Columns("生徒_NO"))
------------------------------------------------------------
・変数"objDs"の"CLASS"テーブルのRowsプロパティから"DataRow"を順次読み出し、当該レコードの"CLASS"テーブル内の行インデックスを取得する。
------------------------------------------------------------
Dim intClsRowNo As Integer = _
objDs.Tables("CLASS").Rows.IndexOf(objClsDr)
------------------------------------------------------------
・今回は複数のテーブルから値を取得してExcelに編集するため、編集する項目ヘッダーは固定値を"Object"型の配列変数"objCol"に設定した後、"Object"型の配列変数"objRow"の先頭要素に格納する。
・続いて変数"objDs"の"CLASS"テーブルの現在行に対してGetChildRowsメソッド(引数にはリレーション名"CS_REL"を指定)を実行して該当する"STUDENT"テーブルの"DataRow"を順次読み出し、該当レコードの"STUDENT"テーブル内の行インデックスを取得する。
------------------------------------------------------------
For Each objCSDr As DataRow In _
objDs.Tables("CLASS").Rows(intClsRowNo).GetChildRows( _
"CS_REL")
・・・
Next
------------------------------------------------------------
・"DataRow"型のオブジェクト変数"objST1Dr()"、"objST2Dr()"に"STUDENT"テーブルの現在行に対してGetChildRowsメソッド(引数にはリレーション名はそれぞれ"ST1_REL"、"ST2_REL"を指定)を実行して該当する"T1_RECORD"、"T2_RECORD"テーブルの"DataRow"を取得する。
※変数"objST1Dr()"、"objST2Dr()"は配列になっているが、データの性格上1レコードしか取得されないのでこのような取得方法としている。
・"Object"型の配列変数"objCol"に"CLASS"、"STUDENT"、"T1_RECORD"、"T2_RECORD"テーブルの当該レコードから各々フィールドの値を取得して設定した後、"Object"型の配列変数"objRow"に格納する。
・"CLASS"テーブルの現在行に該当する"STUDENT"テーブルのすべてのレコードについて"Object"型の配列変数"objRow"に格納し終えたらその内容をExcelに追加編集するのだが、本サンプルではコンソールウインドウに取得したレコード内容を表示している関係でExcel編集に必要のないフィールドも配列に設定されているので、Excelに編集するのに必要な要素だけを"Object"型の配列変数"objData"にコピーする。以下は"Array.Copy"を使用した配列のコピー例だ。
------------------------------------------------------------
'抽出データの配列を編集用配列にコピー
ReDim objData(objRow.Length - 1)
For i As Integer = 0 To objRow.Length - 1
Dim objTmp(7) As Object
objCol = CType(objRow(i), Object())
Array.Copy(objCol, 4, objTmp, 0, 8)
objData(i) = CType(objTmp, Object)
Next i
------------------------------------------------------------
・コピーした"Object"型の配列変数"objData"を使用して先ほど「6.テーブルよりデータを抽出してExcelに編集する(1)」で作成したExcelシート(該当する学年、学級のシート)に追加編集する。
・上記の要領で変数"objDs"の"CLASS"テーブルに抽出したすべての学級データに対して各生徒の成績情報をExcelシートに編集し終えたら処理終了だ。
7.Excelインスタンスの終了とデータベースのクローズ
最後に作成したExcelブックに名前を付けて保存したら起動したExcelインスタンスを閉じて終了し、データベースコネクションオブジェクトのCloseメソッドを実行してデータベースを閉じる。
以下のの例を実行するには、新規の「コンソールアプリケーション」を作成し、コードを"Module1"に貼り付けて実行すれば良い。
コンソールウインドウが開き、各種処理内容の確認を交えながら上記の処理が実行される。
尚、今回作成したExcelブックはアプリケーションの実行パスに保存されているので、そこから編集結果を確認していただきたい。
------------------------------------------------------------
Imports System.Runtime.InteropServices
Imports System.Data.OleDb
Imports Microsoft.Office.Interop
Imports ADOX
Module Module1
'定数宣言
Private Const HWND_TOPMOST _
As Integer = -1 '最前面にする
'Accessデータベース定数
Private Const CON_ADO_PROVIDER As String = "Provider=Microsoft.ACE.OLEDB.12.0;"
Private Const CON_ADO_DATASOURCE As String = "Data Source="
Private Const CON_FIELD_TYPE_AUTONUMBER As String = "COUNTER(1)"
Private Const CON_FIELD_TYPE_DATE As String = "DATE"
Private Const CON_FIELD_TYPE_INTEGER As String = "INTEGER"
Private Const CON_FIELD_TYPE_TEXT As String = "TEXT"
'その他定数
Private Const CON_DB_FILE As String = "TestSchool.accdb"
'構造体宣言
Private Structure RECT
Dim Left As Integer
Dim Top As Integer
Dim Right As Integer
Dim Bottom As Integer
End Structure
'列挙体宣言
Private Enum DATA_TYPE
Dt_Auto = 0
Dt_Num = 1
Dt_Text = 2
Dt_Date = 3
End Enum
Private Enum SELECT_TYPE
St_StdAtCls = 0
End Enum
'変数宣言
Private gstrAppPath As String
Private gobjDbCon As OleDbConnection
Private gobjExcel As Excel.Application
Private gobjDmyXls As Excel.Application
Private gstrTblName() As String = {"学級", "科目", "教師", "生徒", "成績"}
Private gobjClassItem(,) As Object = {{"ROW_NO", 0, 0}, {"学年", 1, 0}, {"学級", 2, 4}}
Private gobjSubjectItem(,) As Object = {{"ROW_NO", 0, 0}, {"科目", 2, 10}}
Private gobjTeacherItem(,) As Object = {{"ROW_NO", 0, 0}, {"学級_NO", 1, 0}, _
{"氏名_姓", 2, 20}, {"氏名_名", 2, 20}, _
{"性別", 2, 6}, {"生年月日", 3, 0}, {"役職", 2, 10}}
Private gobjStudentItem(,) As Object = {{"ROW_NO", 0, 0}, {"学級_NO", 1, 0}, _
{"氏名_姓", 2, 20}, {"氏名_名", 2, 20}, _
{"性別", 2, 6}, {"生年月日", 3, 0}}
Private gobjRecordItem(,) As Object = {{"ROW_NO", 0, 0}, {"生徒_NO", 1, 0}, _
{"科目_NO", 1, 0}, {"学期", 1, 0}, {"得点", 1, 0}}
Private gobjClassIndex(,) As Object = {{"idxYear", "学年"}, {"idxClass", "学級"}}
Private gobjSubjectIndex(,) As Object = {{"idxSubject", "科目"}}
Private gobjTeacherIndex(,) As Object = {{"idxSex", "性別"}, {"idxRank", "役職"}}
Private gobjStudentIndex(,) As Object = {{"idxClassNo", "学級_No", ""}, _
{"idxSex", "性別", ""}, _
{"idxBirthday", "生年月日", ""}, _
{"idxClassSex", "学級_No", "性別"}}
Private gobjRecordIndex(,) As Object = {{"idxStudentNo", "生徒_No", ""}, _
{"idxSubjectNo", "科目_No", ""}, _
{"idxTerm", "学期", ""}, _
{"idxScore", "得点", ""}, _
{"idxStuSub", "生徒_No", "科目_No"}, _
{"idxStuTerm", "生徒_No", "学期"}}
Private gobjClassData(,) As Object = {{1, 1, "A"}, {2, 1, "B"}, {3, 2, "A"}, _
{4, 2, "B"}, {5, 3, "A"}}
Private gobjSubjectData(,) As Object = {{1, "国語"}, {2, "数学"}, {3, "英語"}}
Private gobjTeacherData(,) As Object = {{1, 1, "山田", "太郎", "男", "1960/4/20", ""}, _
{2, 2, "鈴木", "花子", "女", "1972/2/5", "学年主任"}, _
{3, 3, "小林", "恵子", "女", "1962/7/16", "学年主任"}, _
{4, 4, "佐藤", "次郎", "男", "1976/6/6", ""}, _
{5, 5, "斉藤", "春子", "女", "1968/12/22", "学年主任"}}
Private gobjStudentData(,) As Object = {{1, 1, "石川", "さゆり", "女", "1998/1/30"}, _
{2, 2, "泉谷", "しげる", "男", "1997/5/11"}, _
{3, 3, "五木", "ひろし", "男", "1997/3/14"}, _
{4, 4, "北島", "三郎", "男", "1996/10/4"}, _
{5, 5, "きゃりー", "ぱみゅぱみゅ", "女", "1996/1/29"}, _
{6, 1, "クリス", "ハート", "男", "1997/8/25"}, _
{7, 2, "郷", "ひろみ", "男", "1997/10/18"}, _
{8, 3, "香西", "かおり", "女", "1996/8/28"}, _
{9, 4, "伍代", "夏子", "女", "1996/12/18"}, _
{10, 5, "坂本", "冬美", "女", "1996/3/30"}, _
{11, 1, "高橋", "真梨子", "女", "1998/3/6"}, _
{12, 2, "天童", "よしみ", "女", "1997/9/26"}, _
{13, 3, "徳永", "英明", "男", "1997/2/27"}, _
{14, 4, "西野", "カナ", "女", "1997/3/18"}, _
{15, 5, "浜崎", "あゆみ", "女", "1995/10/2"}, _
{16, 1, "氷川", "きよし", "男", "1997/9/6"}, _
{17, 2, "福田", "こうへい", "男", "1997/9/21"}, _
{18, 3, "福山", "雅治", "男", "1997/2/6"}, _
{19, 4, "藤", "あや子", "女", "1996/5/10"}, _
{20, 5, "細川", "たかし", "男", "1995/6/15"}, _
{21, 1, "松田", "聖子", "女", "1998/3/10"}, _
{22, 2, "水樹", "奈々", "女", "1998/1/21"}, _
{23, 3, "水森", "かおり", "女", "1996/8/31"}, _
{24, 4, "美輪", "明宏", "男", "1996/5/15"}, _
{25, 5, "森", "進一", "男", "1995/11/18"}, _
{26, 5, "和田", "アキ子", "女", "1995/4/10"}}
Private gobjRecordData(,) As Object = {{1, 1, 1, 1, 90}, {2, 1, 2, 1, 92}, {3, 1, 3, 1, 95}, _
{4, 1, 1, 2, 95}, {5, 1, 2, 2, 90}, {6, 1, 3, 2, 98}, _
{7, 2, 1, 1, 79}, {8, 2, 2, 1, 68}, {9, 2, 3, 1, 80}, _
{10, 2, 1, 2, 62}, {11, 2, 2, 2, 78}, {12, 2, 3, 2, 72}, _
{13, 3, 1, 1, 68}, {14, 3, 2, 1, 70}, {15, 3, 3, 1, 65}, _
{16, 3, 1, 2, 55}, {17, 3, 2, 2, 60}, {18, 3, 3, 2, 52}, _
{19, 4, 1, 1, 88}, {20, 4, 2, 1, 95}, {21, 4, 3, 1, 100}, _
{22, 4, 1, 2, 100}, {23, 4, 2, 2, 98}, {24, 4, 3, 2, 98}, _
{25, 5, 1, 1, 60}, {26, 5, 2, 1, 62}, {27, 5, 3, 1, 65}, _
{28, 5, 1, 2, 62}, {29, 5, 2, 2, 60}, {30, 5, 3, 2, 65}, _
{31, 6, 1, 1, 50}, {32, 6, 2, 1, 52}, {33, 6, 3, 1, 45}, _
{34, 6, 1, 2, 55}, {35, 6, 2, 2, 50}, {36, 6, 3, 2, 48}, _
{37, 7, 1, 1, 79}, {38, 7, 2, 1, 78}, {39, 7, 3, 1, 70}, _
{40, 7, 1, 2, 72}, {41, 7, 2, 2, 78}, {42, 7, 3, 2, 72}, _
{43, 8, 1, 1, 68}, {44, 8, 2, 1, 70}, {45, 8, 3, 1, 65}, _
{46, 8, 1, 2, 75}, {47, 8, 2, 2, 80}, {48, 8, 3, 2, 72}, _
{49, 9, 1, 1, 98}, {50, 9, 2, 1, 95}, {51, 9, 3, 1, 100}, _
{52, 9, 1, 2, 100}, {53, 9, 2, 2, 100}, {54, 9, 3, 2, 99}, _
{55, 10, 1, 1, 80}, {56, 10, 2, 1, 82}, {57, 10, 3, 1, 85}, _
{58, 10, 1, 2, 82}, {59, 10, 2, 2, 80}, {60, 10, 3, 2, 85}, _
{61, 11, 1, 1, 90}, {62, 11, 2, 1, 62}, {63, 11, 3, 1, 85}, _
{64, 11, 1, 2, 95}, {65, 11, 2, 2, 70}, {66, 11, 3, 2, 88}, _
{67, 12, 1, 1, 49}, {68, 12, 2, 1, 48}, {69, 12, 3, 1, 40}, _
{70, 12, 1, 2, 42}, {71, 12, 2, 2, 48}, {72, 12, 3, 2, 42}, _
{73, 13, 1, 1, 68}, {74, 13, 2, 1, 73}, {75, 13, 3, 1, 64}, _
{76, 13, 1, 2, 73}, {77, 13, 2, 2, 81}, {78, 13, 3, 2, 76}, _
{79, 14, 1, 1, 100}, {80, 14, 2, 1, 97}, {81, 14, 3, 1, 100}, _
{82, 14, 1, 2, 100}, {83, 14, 2, 2, 98}, {84, 14, 3, 2, 100}, _
{85, 15, 1, 1, 30}, {86, 15, 2, 1, 42}, {87, 15, 3, 1, 35}, _
{88, 15, 1, 2, 32}, {89, 15, 2, 2, 40}, {90, 15, 3, 2, 35}, _
{91, 16, 1, 1, 10}, {92, 16, 2, 1, 12}, {93, 16, 3, 1, 15}, _
{94, 16, 1, 2, 15}, {95, 16, 2, 2, 10}, {96, 16, 3, 2, 18}, _
{97, 17, 1, 1, 89}, {98, 17, 2, 1, 87}, {99, 17, 3, 1, 91}, _
{100, 17, 1, 2, 90}, {101, 17, 2, 2, 88}, {102, 17, 3, 2, 92}, _
{103, 18, 1, 1, 69}, {104, 18, 2, 1, 79}, {105, 18, 3, 1, 69}, _
{106, 18, 1, 2, 70}, {107, 18, 2, 2, 80}, {108, 18, 3, 2, 70}, _
{109, 19, 1, 1, 87}, {110, 19, 2, 1, 94}, {111, 19, 3, 1, 99}, _
{112, 19, 1, 2, 88}, {113, 19, 2, 2, 95}, {114, 19, 3, 2, 98}, _
{115, 20, 1, 1, 30}, {116, 20, 2, 1, 32}, {117, 20, 3, 1, 35}, _
{118, 20, 1, 2, 32}, {119, 20, 2, 2, 30}, {120, 20, 3, 2, 35}, _
{121, 21, 1, 1, 20}, {122, 21, 2, 1, 22}, {123, 21, 3, 1, 25}, _
{124, 21, 1, 2, 25}, {125, 21, 2, 2, 20}, {126, 21, 3, 2, 28}, _
{127, 22, 1, 1, 86}, {128, 22, 2, 1, 86}, {129, 22, 3, 1, 86}, _
{130, 22, 1, 2, 92}, {131, 22, 2, 2, 92}, {132, 22, 3, 2, 92}, _
{133, 23, 1, 1, 68}, {134, 23, 2, 1, 73}, {135, 23, 3, 1, 66}, _
{136, 23, 1, 2, 79}, {137, 23, 2, 2, 84}, {138, 23, 3, 2, 77}, _
{139, 24, 1, 1, 81}, {140, 24, 2, 1, 91}, {141, 24, 3, 1, 90}, _
{142, 24, 1, 2, 89}, {143, 24, 2, 2, 99}, {144, 24, 3, 2, 98}, _
{145, 25, 1, 1, 100}, {146, 25, 2, 1, 100}, {147, 25, 3, 1, 100}, _
{148, 25, 1, 2, 100}, {149, 25, 2, 2, 100}, {150, 25, 3, 2, 100}, _
{151, 26, 1, 1, 99}, {152, 26, 2, 1, 99}, {153, 26, 3, 1, 99}, _
{154, 26, 1, 2, 100}, {155, 26, 2, 2, 99}, {156, 26, 3, 2, 98}}
'WindowsAPI宣言
Private Declare Function GetConsoleWindow Lib "kernel32" () As Integer
Private Declare Function GetWindowRect Lib "user32.dll" (ByVal hwnd As Integer, ByRef lpRect As RECT) As Integer
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Integer, ByVal hWndInsertAfter As Integer, _
ByVal x As Integer, ByVal y As Integer, ByVal cx As Integer, _
ByVal cy As Integer, ByVal wFlags As Integer) As Integer
Sub Main()
Dim strMsg As String = ""
Try
'コンソールウインドウを設定
Dim intHwnd As Integer = GetConsoleWindow
Dim typRect As RECT = New RECT
Call GetWindowRect(intHwnd, typRect)
Call SetWindowPos(intHwnd, HWND_TOPMOST, 50, 50, typRect.Right - typRect.Left, typRect.Bottom - typRect.Top, 0)
Call subPutConsoleMsgAndWait("テスト用データベースの作成を行います...")
'アプリケーションのパスを取得
Dim objAssembly As System.Reflection.Assembly = System.Reflection.Assembly.GetEntryAssembly
gstrAppPath = IO.Path.GetDirectoryName(objAssembly.Location)
'データベースを作成
If fncCreateDatabase() = False Then
MsgBox("データベースの作成に失敗しました。" & ControlChars.CrLf & "アプリケーションを終了します。", MsgBoxStyle.Exclamation)
strMsg = "処理が中断されました..."
Exit Try
End If
'Excelインスタンスの起動
Call subPutConsoleMsg("Excelのインスタンスを起動しています...")
If fncStartExcel() = False Then
MsgBox("Excelの起動に失敗しました。" & ControlChars.CrLf & "アプリケーションを終了します。", MsgBoxStyle.Exclamation)
strMsg = "処理が中断されました..."
Exit Try
End If
'Excelブックを新規作成
If fncCreateExcelBook() = False Then
MsgBox("Excelブックの作成に失敗しました。" & ControlChars.CrLf & "アプリケーションを終了します。", MsgBoxStyle.Exclamation)
strMsg = "処理が中断されました..."
Exit Try
End If
'データベースを操作
If fncOperateDatabase() = False Then
strMsg = "処理が中断されました..."
Exit Try
End If
Call subPutConsoleMsg("すべての確認が終了しました...")
strMsg = "データ抽出の処理結果は" & IO.Path.Combine(gstrAppPath, My.Application.Info.AssemblyName & ".xls") & "を確認してください..."
Catch ex As Exception
'エラーが発生した場合
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
strMsg = "処理が中断されました..."
Finally
Call subPutConsoleMsgAndWait(strMsg)
'Excelインスタンスの終了
Call subQuitExcel()
End Try
End Sub
Private Function fncConfirmTabelItem() As Boolean
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'テーブルとそのフィールドを確認する
'
' 戻り値 ： True:正常、False:異常
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim blnReturn As Boolean
Try
Call subPutConsoleMsgAndWait("データベースのテーブルとそのフィールド、インデックスを確認します...")
'データベースのユーザテーブル名を取得
Dim strTableName() As String = {}
If fncGetTabelName(strTableName) = False Then
blnReturn = False
Exit Try
End If
For i As Integer = 0 To strTableName.Length - 1
Call subPutConsoleMsgAndWait("'" & strTableName(i) & "'テーブルが見つかりました...")
'テーブルのフィールド名を列挙
Call subPutConsoleMsg("テーブル内のフィールドは以下の通りです...")
'テーブルデータ取得SQLを生成
Dim objCmd As OleDbCommand = New OleDbCommand("SELECT * FROM " & strTableName(i) & ";", gobjDbCon)
'データリーダーで指定テーブルを取得
Using objRd As OleDbDataReader = objCmd.ExecuteReader
'データリーダーのスキーマテーブルを取得
Using objDt As DataTable = objRd.GetSchemaTable
'取得したデータテーブルのレコードから"ColumnOrdinal"列(2番目の列)、"ColumnName"列(1番目の列)、
'"DataType"列(6番目の列)、"ColumnSize"列(3番目の列)を取得
For Each objDr As DataRow In objDt.Rows
Dim strMsg As String = "<フィールド" & objDr(1).ToString & ">" & _
" 名称：" & objDr(0).ToString & "、タイプ：" & objDr(5).ToString
Dim objType As Type = GetType(System.String)
If objDr(5).Equals(objType) Then
'タイプがStringの場合、サイズを取得
strMsg = strMsg & "、サイズ：" & objDr(2).ToString
End If
Call subPutConsoleMsg(strMsg)
Next
End Using
'データリーダーをクローズ
objRd.Close()
End Using
Call subPutConsoleMsgAndWait()
'テーブルのインデックスを列挙
Call subPutConsoleMsg("テーブルに設定されたインデックスは以下の通りです...")
Dim strIndex(0) As String
'スキーマテーブルから指定テーブルのインデックス情報を取得
Using objIndexes As DataTable = gobjDbCon.GetOleDbSchemaTable(OleDbSchemaGuid.Indexes, _
New Object() {Nothing, Nothing, Nothing, Nothing, strTableName(i)})
'取得したデータテーブルのレコードから"INDEX_NAME"列(6番目の列)を取得
For Each objDr As DataRow In objIndexes.Rows
Dim strName As String = objDr(5).ToString
If Array.FindIndex(strIndex, Function(pIndex As String) pIndex = strName) = -1 Then
'配列に取得したインデックス名が存在しない場合、配列にインデックス名を追加
If Not IsNothing(strIndex(strIndex.Length - 1)) Then
ReDim Preserve strIndex(strIndex.Length)
End If
strIndex(strIndex.Length - 1) = strName
End If
Next
End Using
'取得したインデックスを構成する列名を取得
For j As Integer = 0 To strIndex.Length - 1
'スキーマテーブルから指定テーブル、インデックスのインデックス情報を取得
Using objIndexes As DataTable = gobjDbCon.GetOleDbSchemaTable(OleDbSchemaGuid.Indexes, _
New Object() {Nothing, Nothing, strIndex(j), Nothing, strTableName(i)})
Call subPutConsoleMsg("<インデックス：" & strIndex(j) & ">")
'取得したデータテーブルのレコードから"ORDINAL_POSITION"列(17番目の列)、"COLUMN_NAME"列(18番目の列)を取得
For Each objDr As DataRow In objIndexes.Rows
Call subPutConsoleMsg("フィールド" & objDr(16).ToString & "：" & objDr(17).ToString)
Next
If j < strIndex.Length - 1 Then
Call subPutConsoleMsg()
End If
End Using
Next j
Call subPutConsoleMsgAndWait()
Next i
blnReturn = True
Catch dbex As OleDbException
'エラーが発生した場合
MsgBox(dbex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
Catch ex As Exception
'エラーが発生した場合
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
End Try
Return blnReturn
End Function
Private Function fncChangeArray(ByVal pSrc() As Object, ByRef pDest(,) As Object, ByVal pColCnt As Integer) As Boolean
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'二段階配列を二次元配列に変換
'
' pSrc ： 変換する二段階配列
' pDest ： 変換した二次元配列
' pColCnt ： 編集するデータの列数
'
' 戻り値 ： True:正常、False:異常
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim blnReturn As Boolean
Try
If pSrc.Length = 1 Then
'二段階配列の要素数が1の場合、二段階配列にダミー要素を追加
'※ 要素数1の場合、行列の入れ替えで配列の次元数が減少することの対策
'※ 追加したダミーの配列はNothingのため、Excelに編集する際に無視される
Dim objDummy(pColCnt - 1) As Object
ReDim Preserve pSrc(pSrc.Length)
pSrc(pSrc.Length - 1) = objDummy
End If
'二段階配列の行列を入れ替えて二次元配列に変換
'pSrc(R)(C)→objArray(C,R)に変換
Dim objFunc As Excel.WorksheetFunction = _
DirectCast(gobjExcel.WorksheetFunction, Excel.WorksheetFunction)
Dim objArray(,) As Object = CType(objFunc.Transpose(pSrc), Object(,))
'変換した二次元配列の行列を再度入れ替えて行列を元に戻す
'objArray(C,R)→pDest(R,C)に変換
pDest = CType(objFunc.Transpose(objArray), Object(,))
blnReturn = True
Catch comex As COMException
'エラーが発生した場合
MsgBox(comex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
Catch ex As Exception
'エラーが発生した場合
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
End Try
Return blnReturn
End Function
Private Function fncCreateDatabase() As Boolean
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'Accessデータベースを作成
'
' 戻り値 ： True:正常、False:異常
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim blnReturn As Boolean
Dim objDbCat As Catalog = Nothing
Dim objDbCon As OleDbConnection = Nothing
Dim objDbCon As ADODB.Connection = Nothing
Try
Dim strPath As String = IO.Path.Combine(gstrAppPath, CON_DB_FILE)
'データベースの存在確認
If FileIO.FileSystem.FileExists(strPath) = True Then
'データベースが既に存在する場合
If MsgBox("データベースは既に存在します。" & ControlChars.CrLf & "削除してよろしいですか。", _
MsgBoxStyle.Question Or MsgBoxStyle.YesNo Or MsgBoxStyle.DefaultButton1) = MsgBoxResult.No Then
blnReturn = False
Exit Try
Else
'既存のデータベースを削除
FileIO.FileSystem.DeleteFile(strPath)
End If
End If
'データベース接続文字列を生成
Dim strConString As String = CON_ADO_PROVIDER & CON_ADO_DATASOURCE & strPath
'データベースカタログのインスタンスを生成
objDbCat = New Catalog
'データベースを作成
objDbCat.Create(strConString)
'データベースコネクションのインスタンスを生成
objDbCon = New OleDbConnection(strConString)
objDbCon = CType(objDbCat.ActiveConnection, ADODB.Connection)
'データベースをクローズ
If Not IsNothing(objDbCon) Then
If objDbCon.State <> ConnectionState.Closed Then
objDbCon.Close()
End If
Call subPutConsoleMsg("以下のパスにデータベースを作成しました...")
Call subPutConsoleMsgAndWait(strPath)
Call subPutConsoleMsg()
blnReturn = True
Catch dbex As OleDbException
'エラーが発生した場合
MsgBox(dbex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
Catch ex As Exception
'エラーが発生した場合
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
Finally
'データベースカタログのインスタンスを破棄
If Not IsNothing(objDbCat) Then
Call subMRComObject(CType(objDbCat, Object))
objDbCat = Nothing
End If
'データベースコネクションのインスタンスを破棄
If Not IsNothing(objDbCon) Then
Call subMRComObject(CType(objDbCon, Object))
objDbCon = Nothing
End If
End Try
Return blnReturn
End Function
Private Function fncCreateExcelBook() As Boolean
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'Excelブックを新規作成
'
' 戻り値 ： True:正常、False:異常
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim blnReturn As Boolean
Dim objBk As Excel.Workbook = Nothing
Try
'Excelブックを新規作成
objBk = gobjExcel.Workbooks.Add
blnReturn = True
Catch comex As COMException
'エラーが発生した場合
MsgBox(comex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
Catch ex As Exception
'エラーが発生した場合
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
Finally
If Not IsNothing(objBk) Then
Call subMRComObject(CType(objBk, Object))
objBk = Nothing
End If
End Try
Return blnReturn
End Function
Private Function fncCreateIndex() As Boolean
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'テーブルにインデックスを作成
'
' 戻り値 ： True:正常、False:異常
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim blnReturn As Boolean
Try
Call subPutConsoleMsgAndWait("テーブルにインデックスを作成します...")
For i As Integer = 0 To gstrTblName.Length - 1
'インデックス作成SQLの生成
Dim stbSql As System.Text.StringBuilder
Dim objIdx(,) As Object = {}
Select Case gstrTblName(i)
Case "学級" : objIdx = gobjClassIndex
Case "科目" : objIdx = gobjSubjectIndex
Case "教師" : objIdx = gobjTeacherIndex
Case "生徒" : objIdx = gobjStudentIndex
Case "成績" : objIdx = gobjRecordIndex
End Select
'コマンドオブジェクトの生成
Dim objCmd As OleDbCommand = Nothing
For j As Integer = 0 To objIdx.GetLength(0) - 1
stbSql = New System.Text.StringBuilder
stbSql.Append("CREATE INDEX " & objIdx(j, 0).ToString & " ON " & gstrTblName(i) & " (")
For k As Integer = 1 To objIdx.GetLength(1) - 1
'フィールド名
If objIdx(j, k).ToString <> "" Then
If k > 1 Then
stbSql.Append(", ")
End If
stbSql.Append(objIdx(j, k).ToString)
End If
Next k
stbSql.Append(");")
Call subPutConsoleMsg("'" & gstrTblName(i) & "'テーブルのインデックス作成SQLを以下の通り生成しました...")
Call subPutConsoleMsgAndWait(stbSql.ToString)
'インデックスを追加
objCmd = New OleDbCommand(stbSql.ToString, gobjDbCon)
objCmd.ExecuteNonQuery()
'コマンドオブジェクトを破棄
objCmd.Dispose()
objCmd = Nothing
Call subPutConsoleMsg("'" & gstrTblName(i) & "'テーブルにインデックスを作成しました...")
Call subPutConsoleMsg()
Next j
Next i
blnReturn = True
Catch dbex As OleDbException
'エラーが発生した場合
MsgBox(dbex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
Catch ex As Exception
'エラーが発生した場合
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
End Try
Return blnReturn
End Function
Private Function fncCreateTable() As Boolean
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'データベースにテーブルを作成
'
' 戻り値 ： True:正常、False:異常
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim blnReturn As Boolean
Try
Call subPutConsoleMsgAndWait("データベースにテーブルを作成します...")
For i As Integer = 0 To gstrTblName.Length - 1
'テーブル作成SQLの生成
'テーブル名
Dim stbSql As System.Text.StringBuilder = New System.Text.StringBuilder("CREATE TABLE " & gstrTblName(i) & " (")
'フィールド名、タイプ
Dim objItem(,) As Object = {}
Select Case gstrTblName(i)
Case "学級" : objItem = gobjClassItem
Case "科目" : objItem = gobjSubjectItem
Case "教師" : objItem = gobjTeacherItem
Case "生徒" : objItem = gobjStudentItem
Case "成績" : objItem = gobjRecordItem
End Select
For j As Integer = 0 To objItem.GetLength(0) - 1
If j > 0 Then
stbSql.Append(", ")
End If
'フィールド名
stbSql.Append(objItem(j, 0).ToString)
'タイプ
If IsNumeric(objItem(j, 1)) AndAlso CInt(objItem(j, 1)) = DATA_TYPE.Dt_Auto Then
'オートナンバー型
stbSql.Append(Space(1) & CON_FIELD_TYPE_AUTONUMBER)
ElseIf IsNumeric(objItem(j, 1)) AndAlso CInt(objItem(j, 1)) = DATA_TYPE.Dt_Num Then
'数値型
stbSql.Append(Space(1) & CON_FIELD_TYPE_INTEGER)
ElseIf IsNumeric(objItem(j, 1)) AndAlso CInt(objItem(j, 1)) = DATA_TYPE.Dt_Text Then
'テキスト型
stbSql.Append(Space(1) & CON_FIELD_TYPE_TEXT & "(" & CInt(objItem(j, 2)) & ")")
ElseIf IsNumeric(objItem(j, 1)) AndAlso CInt(objItem(j, 1)) = DATA_TYPE.Dt_Date Then
'日付型
stbSql.Append(Space(1) & CON_FIELD_TYPE_DATE)
End If
Next j
stbSql.Append(");")
Call subPutConsoleMsg("'" & gstrTblName(i) & "'テーブル作成SQLを以下の通り生成しました...")
Call subPutConsoleMsgAndWait(stbSql.ToString)
'コマンドオブジェクトのインスタンスを生成
Dim objCmd As OleDbCommand = New OleDbCommand(stbSql.ToString, gobjDbCon)
'テーブル作成SQLの実行
objCmd.ExecuteNonQuery()
Call subPutConsoleMsg("'" & gstrTblName(i) & "'テーブルを作成しました...")
Call subPutConsoleMsg()
'コマンドオブジェクトを破棄
objCmd.Dispose()
objCmd = Nothing
Next i
blnReturn = True
Catch dbex As OleDbException
'エラーが発生した場合
MsgBox(dbex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
Catch ex As Exception
'エラーが発生した場合
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
End Try
Return blnReturn
End Function
Private Function fncEditExcelSheet(ByVal pName As String, ByVal pData() As Object, ByVal pColCnt As Integer, _
ByVal pRow As Integer, ByVal pCol As Integer) As Boolean
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'指定配列の内容をExcelシートに編集
'
' pName ： 編集したシートに設定するシート名
' pData ： 編集するデータを格納した配列
' pColCnt ： 編集するデータの列数
' pRow ： 編集開始行番号
' pCol ： 編集開始列番号
'
' 戻り値 ： True:正常、False:異常
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim blnReturn As Boolean
Dim objBk As Excel.Workbook = Nothing
Dim objSheets As Excel.Sheets = Nothing
Dim objSh As Excel.Worksheet = Nothing
Dim objCells As Excel.Range = Nothing
Dim objRange As Excel.Range = Nothing
Dim objColumns As Excel.Range = Nothing
Try
'編集する二段階配列を二次元配列に変換
Dim objData(,) As Object = {}
If fncChangeArray(pData, objData, pColCnt) = False Then
blnReturn = False
Exit Try
End If
'編集するシートを取得
If fncGetExcelSheet(pName) = False Then
blnReturn = False
Exit Try
End If
objBk = gobjExcel.Workbooks(1)
objSheets = objBk.Worksheets
objSh = DirectCast(objSheets(pName), Excel.Worksheet)
'編集するセル範囲を設定
Dim intRowE As Integer = pRow + objData.GetLength(0) - 1
Dim intColE As Integer = pCol + objData.GetLength(1) - 1
objCells = DirectCast(objSh.Cells, Excel.Range)
objRange = DirectCast(objCells.Range(objCells.Item(pRow, pCol), objCells.Item(intRowE, intColE)), Excel.Range)
With objRange
.WrapText = False
.Value = objData
End With
'列幅を調整
objColumns = DirectCast(objSh.Columns, Excel.Range)
objColumns.AutoFit()
blnReturn = True
Catch comex As COMException
'エラーが発生した場合
MsgBox(comex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
Catch ex As Exception
'エラーが発生した場合
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
Finally
If Not IsNothing(objColumns) Then
Call subMRComObject(CType(objColumns, Object))
objColumns = Nothing
End If
If Not IsNothing(objRange) Then
Call subMRComObject(CType(objRange, Object))
objRange = Nothing
End If
If Not IsNothing(objCells) Then
Call subMRComObject(CType(objCells, Object))
objCells = Nothing
End If
If Not IsNothing(objSh) Then
Call subMRComObject(CType(objSh, Object))
objSh = Nothing
End If
If Not IsNothing(objSheets) Then
Call subMRComObject(CType(objSheets, Object))
objSheets = Nothing
End If
If Not IsNothing(objBk) Then
Call subMRComObject(CType(objBk, Object))
objBk = Nothing
End If
End Try
Return blnReturn
End Function
Private Function fncExecSelectSqlExample() As Boolean
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'抽出SQL例の実行
'
' 戻り値 ： True:正常、False:異常
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim blnReturn As Boolean
Try
Call subPutConsoleMsgAndWait("生徒テーブルから学級毎に抽出するサンプルSQLを実行します...")
Call subPutConsoleMsg()
'学級テーブルの抽出SQLを生成
Dim strClsSql As String = "SELECT * FROM 学級 ORDER BY 学年, 学級;"
'生徒テーブルの抽出SQLを生成
Dim strStdSql As String = "SELECT C.学年, C.学級, S.氏名_姓, S.氏名_名, S.性別, S.生年月日 " & _
"FROM 学級 AS C, 生徒 AS S WHERE S.学級_NO = @ClassNo AND C.ROW_NO = S.学級_NO ORDER BY S.生年月日;"
'学級、生徒テーブル抽出のコマンドオブジェクトを生成
Using objClsCmd As OleDbCommand = New OleDbCommand(strClsSql, gobjDbCon), _
objStdCmd As OleDbCommand = New OleDbCommand(strStdSql, gobjDbCon)
'生徒コマンドオブジェクトのParameterを初期化
objStdCmd.Parameters.Clear()
Call subPutConsoleMsg("学級毎に生徒を抽出するSQLを以下の通り生成しました...")
Call subPutConsoleMsgAndWait(strStdSql.ToString)
'学級テーブルのデータリーダーを生成
Using objClsRd As OleDbDataReader = objClsCmd.ExecuteReader
Do While objClsRd.Read = True
'生徒コマンドオブジェクトのParameterを設定
objStdCmd.Parameters.Add("@ClassNo", OleDbType.Integer)
objStdCmd.Parameters(0).Value = objClsRd.Item("ROW_NO")
'生徒テーブルからレコードを抽出
If fncGetStudentAtClass(objStdCmd, CInt(objClsRd.Item("学年")), objClsRd.Item("学級").ToString) = False Then
Exit Do
End If
Loop
objClsRd.Close()
End Using
End Using
Call subPutConsoleMsgAndWait("成績テーブルから学級、生徒、学期毎に抽出するサンプルSQLを実行します...")
Call subPutConsoleMsg()
'生徒テーブルの抽出SQLを生成
strStdSql = "SELECT * FROM 生徒 ORDER BY 生年月日;"
'一学期の成績データの抽出SQLを生成
Dim strTrm1Sql As String = "SELECT J.生徒_NO, J.得点, M.得点, E.得点, J.得点 + M.得点 + E.得点 AS 合計 FROM " & _
"(SELECT * FROM 成績 WHERE 学期 = 1 AND 科目_NO = 1) AS J, " & "(SELECT * FROM 成績 WHERE 学期 = 1 AND 科目_NO = 2) AS M, " & _
"(SELECT * FROM 成績 WHERE 学期 = 1 AND 科目_NO = 3) AS E " & "WHERE J.生徒_NO = M.生徒_NO AND J.生徒_NO = E.生徒_NO " & _
"ORDER BY J.生徒_NO;"
Call subPutConsoleMsg("生徒毎に一学期の成績を抽出するSQLを以下の通り生成しました...")
Call subPutConsoleMsgAndWait(strTrm1Sql.ToString)
'二学期の成績データの抽出SQLを生成
Dim strTrm2Sql As String = "SELECT J.生徒_NO, J.得点, M.得点, E.得点, J.得点 + M.得点 + E.得点 AS 合計 FROM " & _
"(SELECT * FROM 成績 WHERE 学期 = 2 AND 科目_NO = 1) AS J, " & "(SELECT * FROM 成績 WHERE 学期 = 2 AND 科目_NO = 2) AS M, " & _
"(SELECT * FROM 成績 WHERE 学期 = 2 AND 科目_NO = 3) AS E " & "WHERE J.生徒_NO = M.生徒_NO AND J.生徒_NO = E.生徒_NO " & _
"ORDER BY J.生徒_NO;"
Call subPutConsoleMsg("生徒毎に二学期の成績を抽出するSQLを以下の通り生成しました...")
Call subPutConsoleMsgAndWait(strTrm2Sql.ToString)
'成績テーブルからレコードを抽出
If fncGetRecordAtStudent(strClsSql, strStdSql, strTrm1Sql, strTrm2Sql) = False Then
blnReturn = False
Exit Try
End If
blnReturn = True
Catch dbex As OleDbException
'エラーが発生した場合
MsgBox(dbex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
Catch ex As Exception
'エラーが発生した場合
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
End Try
Return blnReturn
End Function
Private Function fncGetExcelSheet(ByVal pName As String) As Boolean
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'指定名称のシートを取得または作成
'
' pName ： 取得するシート名
'
' 戻り値 ： True:正常、False:異常
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim blnReturn As Boolean
Dim objBk As Excel.Workbook = gobjExcel.Workbooks(1)
Dim objSheets As Excel.Sheets = objBk.Worksheets
Dim objSheet As Excel.Worksheet = Nothing
Try
Dim blnHit As Boolean = False
'指定名称のシートを取得
For Each objSheet In objSheets
If objSheet.Name = pName Then
'シート名が指定名称の場合
blnHit = True
Exit For
End If
Call subMRComObject(CType(objSheet, Object))
Next
If blnHit = False Then
'指定名称のシートが取得できなかった場合、デフォルトシートを取得
For Each objSheet In objSheets
If objSheet.Name Like "Sheet*" Then
'シート名が"Sheet*"ならばシート名を指定名称に変更
objSheet.Name = pName
blnHit = True
Exit For
End If
Call subMRComObject(CType(objSheet, Object))
Next
If blnHit = False Then
'デフォルトシートが存在しない場合、新規シートを作成
objSheet = DirectCast(objSheets.Add(After:=objSheets(objSheets.Count)), Excel.Worksheet)
objSheet.Name = pName
End If
End If
blnReturn = True
Catch comex As COMException
'COMエラーが発生した場合
MsgBox(comex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
Catch ex As Exception
'エラーが発生した場合
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
Finally
If Not IsNothing(objSheet) Then
Call subMRComObject(CType(objSheet, Object))
objSheet = Nothing
End If
If Not IsNothing(objSheets) Then
Call subMRComObject(CType(objSheets, Object))
objSheets = Nothing
End If
If Not IsNothing(objBk) Then
Call subMRComObject(CType(objBk, Object))
objBk = Nothing
End If
End Try
Return blnReturn
End Function
Private Function fncGetRecordAtStudent(ByVal pClsSql As String, ByVal pStdSql As String, ByVal pTrm1Sql As String, _
ByVal pTrm2Sql As String) As Boolean
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'指定SQLの内容で生徒毎の成績データを取得
'
' pClsSql ： 学級テーブルの抽出SQL
' pStdSql ： 生徒テーブルの抽出SQL
' pTrm1Sql： 成績テーブルより一学期の成績データの抽出SQL
' pTrm2Sql： 成績テーブルより二学期の成績データの抽出SQL
'
' 戻り値 ： True:正常、False:異常
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim blnReturn As Boolean
Try
Dim strClassName As String = ""
Dim objRow(0) As Object
Dim objCol(0) As Object
Dim objData(0) As Object
Dim intColCnt As Integer = 0
'学級、生徒、成績テーブルのデータアダプタ、データセットのインスタンスを生成
Using objDs As DataSet = New DataSet(), _
objClsDa As OleDbDataAdapter = New OleDbDataAdapter(pClsSql, gobjDbCon), _
objStdDa As OleDbDataAdapter = New OleDbDataAdapter(pStdSql, gobjDbCon), _
objT1RcdDa As OleDbDataAdapter = New OleDbDataAdapter(pTrm1Sql, gobjDbCon), _
objT2RcdDa As OleDbDataAdapter = New OleDbDataAdapter(pTrm2Sql, gobjDbCon)
'各データアダプタよりデータセットにデータを抽出
objClsDa.Fill(objDs, "CLASS")
objStdDa.Fill(objDs, "STUDENT")
objT1RcdDa.Fill(objDs, "T1_RECORD")
objT2RcdDa.Fill(objDs, "T2_RECORD")
'データセットにテーブル間のリレーションを設定
objDs.Relations.Add("CS_REL", objDs.Tables("CLASS").Columns("ROW_NO"), objDs.Tables("STUDENT").Columns("学級_NO"))
objDs.Relations.Add("ST1_REL", objDs.Tables("STUDENT").Columns("ROW_NO"), objDs.Tables("T1_RECORD").Columns("生徒_NO"))
objDs.Relations.Add("ST2_REL", objDs.Tables("STUDENT").Columns("ROW_NO"), objDs.Tables("T2_RECORD").Columns("生徒_NO"))
'学級テーブルのレコードを順次取得
For Each objClsDr As DataRow In objDs.Tables("CLASS").Rows
Dim intClsRowNo As Integer = objDs.Tables("CLASS").Rows.IndexOf(objClsDr)
'クラス名を設定
strClassName = objClsDr("学年").ToString & "年" & objClsDr("学級").ToString & "組"
Call subPutConsoleMsg(strClassName & "の生徒" & objDs.Tables("CLASS").Rows(intClsRowNo).GetChildRows("CS_REL").Count & _
"名の成績は以下の通りです...")
'抽出データのフィールド名を配列に設定
ReDim objCol(11)
objCol(0) = CType("学年", Object)
objCol(1) = CType("学級", Object)
objCol(2) = CType("氏名_姓", Object)
objCol(3) = CType("氏名_名", Object)
objCol(4) = CType("国語_1", Object)
objCol(5) = CType("数学_1", Object)
objCol(6) = CType("英語_1", Object)
objCol(7) = CType("合計_1", Object)
objCol(8) = CType("国語_2", Object)
objCol(9) = CType("数学_2", Object)
objCol(10) = CType("英語_2", Object)
objCol(11) = CType("合計_2", Object)
ReDim objRow(0)
objRow(objRow.Length - 1) = CType(objCol, Object)
intColCnt = objCol.Length
'取得した学級レコードに該当する生徒テーブルのレコードを順次取得
For Each objCSDr As DataRow In objDs.Tables("CLASS").Rows(intClsRowNo).GetChildRows("CS_REL")
'取得した生徒レコードに該当する一学期、二学期の成績テーブルのレコードを取得
Dim intStdRowNo As Integer = objDs.Tables("STUDENT").Rows.IndexOf(objCSDr)
Dim objST1Dr() As DataRow = objDs.Tables("STUDENT").Rows(intStdRowNo).GetChildRows("ST1_REL")
Dim objST2Dr() As DataRow = objDs.Tables("STUDENT").Rows(intStdRowNo).GetChildRows("ST2_REL")
'取得したデータを配列に格納
ReDim objCol(11)
objCol(0) = CType(CInt(objClsDr("学年")), Object)
objCol(1) = CType(objClsDr("学級").ToString, Object)
objCol(2) = CType(objCSDr("氏名_姓").ToString, Object)
objCol(3) = CType(objCSDr("氏名_名").ToString, Object)
objCol(4) = CType(CInt(objST1Dr(0)("J.得点")), Object)
objCol(5) = CType(CInt(objST1Dr(0)("M.得点")), Object)
objCol(6) = CType(CInt(objST1Dr(0)("E.得点")), Object)
objCol(7) = CType(CInt(CInt(objST1Dr(0)("合計"))), Object)
objCol(8) = CType(CInt(objST2Dr(0)("J.得点")), Object)
objCol(9) = CType(CInt(objST2Dr(0)("M.得点")), Object)
objCol(10) = CType(CInt(objST2Dr(0)("E.得点")), Object)
objCol(11) = CType(CInt(CInt(objST2Dr(0)("合計"))), Object)
If Not IsNothing(objRow(objRow.Length - 1)) Then
ReDim Preserve objRow(objRow.Length)
End If
objRow(objRow.Length - 1) = CType(objCol, Object)
Call subPutConsoleMsg(Join(objCol, ",").ToString)
'一学期、二学期の成績データのインスタンスを破棄
objST1Dr = Nothing
objST2Dr = Nothing
Next
Call subPutConsoleMsgAndWait()
'抽出データの配列を編集用配列にコピー
ReDim objData(objRow.Length - 1)
For i As Integer = 0 To objRow.Length - 1
Dim objTmp(7) As Object
objCol = CType(objRow(i), Object())
Array.Copy(objCol, 4, objTmp, 0, 8)
objData(i) = CType(objTmp, Object)
Next i
'抽出したデータをExcelシートに編集
If fncEditExcelSheet(strClassName, objData, intColCnt, 1, 7) = False Then
MsgBox(strClassName & "のシート編集に失敗しました。", MsgBoxStyle.Exclamation)
blnReturn = False
Exit Try
End If
Next
blnReturn = True
End Using
Catch dbex As OleDbException
'エラーが発生した場合
MsgBox(dbex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
Catch ex As Exception
'エラーが発生した場合
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
End Try
Return blnReturn
End Function
Private Function fncGetStudentAtClass(ByRef pCmd As OleDbCommand, ByVal pYear As Integer, ByVal pClass As String) As Boolean
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'指定SQLの内容で指定学級の生徒データを取得
'
' pCmd ： レコード抽出コマンドオブジェクト
' pYear ： 抽出対象の学年
' pClass ： 抽出対象の学級
'
' 戻り値 ： True:正常、False:異常
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim blnReturn As Boolean
Try
Dim strClassName As String = pYear.ToString & "年" & pClass & "組"
Dim objRow(0) As Object
Dim objCol(0) As Object
Dim intColCnt As Integer = 0
'抽出するデータのフィールド名を取得
'データリーダーで指定テーブルを取得
Using objRd As OleDbDataReader = pCmd.ExecuteReader
'データリーダーのスキーマテーブルを取得
Using objDt As DataTable = objRd.GetSchemaTable
'取得したデータテーブルのレコードからフィールド名を取得
For Each objDr As DataRow In objDt.Rows
If Not IsNothing(objCol(objCol.Length - 1)) Then
ReDim Preserve objCol(objCol.Length)
End If
objCol(objCol.Length - 1) = CType(objDr(0).ToString, Object)
Next
End Using
End Using
objRow(objRow.Length - 1) = CType(objCol, Object)
intColCnt = objCol.Length
'データアダプタのインスタンスを生成
Using objDa As OleDbDataAdapter = New OleDbDataAdapter(pCmd)
'データテーブルのインスタンスを生成
Using objDt As DataTable = New DataTable("Student")
'データテーブルにレコードを抽出
objDa.Fill(objDt)
Call subPutConsoleMsg(strClassName & "の生徒は以下の" & objDt.Rows.Count & "名です...")
For Each objDr As DataRow In objDt.Rows
'データテーブルのレコードを配列に格納
If Not IsNothing(objRow(objRow.Length - 1)) Then
ReDim Preserve objRow(objRow.Length)
End If
objRow(objRow.Length - 1) = CType(objDr.ItemArray, Object)
Call subPutConsoleMsg(Join(objDr.ItemArray, ",").ToString)
Next
End Using
End Using
Call subPutConsoleMsgAndWait()
'抽出したデータをExcelシートに編集
If fncEditExcelSheet(strClassName, objRow, intColCnt, 1, 1) = False Then
MsgBox(strClassName & "のシート編集に失敗しました。", MsgBoxStyle.Exclamation)
blnReturn = False
Exit Try
End If
blnReturn = True
Catch dbex As OleDbException
'エラーが発生した場合
MsgBox(dbex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
Catch ex As Exception
'エラーが発生した場合
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
End Try
Return blnReturn
End Function
Private Function fncGetTabelName(ByRef pTableName() As String) As Boolean
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'データベースのユーザテーブル名を取得
'
' pTableName() : テーブル名(配列)
'
' 戻り値 ： True:正常、False:異常
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim blnReturn As Boolean
Try
'スキーマテーブルからテーブル名を取得
Dim objTables As DataTable = gobjDbCon.GetOleDbSchemaTable(OleDbSchemaGuid.Tables, _
New Object() {Nothing, Nothing, Nothing, "TABLE"})
'取得したデータテーブルのレコードから"TABLE_NAME"列の値を取得
ReDim pTableName(objTables.Rows.Count - 1)
For i As Integer = 0 To objTables.Rows.Count - 1
pTableName(i) = objTables.Rows(i)("TABLE_NAME").ToString
Next
If pTableName(0) = "" Then
'テーブル名が取得できなかった場合
MsgBox("データベースからテーブル名を取得できませんでした。", MsgBoxStyle.Exclamation)
blnReturn = False
Exit Try
End If
blnReturn = True
Catch dbex As OleDbException
'エラーが発生した場合
MsgBox(dbex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
Catch ex As Exception
'エラーが発生した場合
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
End Try
Return blnReturn
End Function
Private Function fncGetTableRecordCount(ByVal pTblName As String) As Boolean
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'指定テーブルのレコード件数を取得
'
' pTblName： 対象テーブル名
'
' 戻り値 ： True:正常、False:異常
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim blnReturn As Boolean
Dim objCmd As OleDbCommand = Nothing
Try
If pTblName = "" Then
MsgBox("テーブル名が指定されていません。", MsgBoxStyle.Exclamation)
blnReturn = False
Exit Try
End If
'レコード件数取得SQLを生成
Dim intCount As Integer
objCmd = New OleDbCommand("SELECT COUNT(*) FROM " & pTblName & ";", gobjDbCon)
Using objRd As OleDbDataReader = objCmd.ExecuteReader
If objRd.Read() = True Then
intCount = CInt(objRd(0))
Else
intCount = 0
End If
'データリーダーをクローズ
objRd.Close()
End Using
Call subPutConsoleMsgAndWait("'" & pTblName & "'テーブルのレコード件数は" & intCount.ToString & "件です...")
blnReturn = True
Catch dbex As OleDbException
'エラーが発生した場合
MsgBox(dbex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
Catch ex As Exception
'エラーが発生した場合
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
Finally
'利用したオブジェクトを破棄
If Not IsNothing(objCmd) Then
objCmd.Dispose() : objCmd = Nothing
End If
End Try
Return blnReturn
End Function
<DebuggerStepThrough()> _
Private Function fncGetUserEntry(ByVal pOption As Boolean) As String
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'コンソールウインドウよりユーザの入力を受付
'
' pOption ： ユーザ入力キーの表示設定
' True:非表示、False:表示
'
' 戻り値 ： ユーザ入力キー
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim strEntry As String = Console.ReadKey(pOption).Key.ToString
Return strEntry
End Function
Private Function fncImportTable() As Boolean
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'テーブルにデータをインポート
'
' 戻り値 ： True:正常、False:異常
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim blnReturn As Boolean
Dim objCmd As OleDbCommand = Nothing
Try
Call subPutConsoleMsgAndWait("各テーブルにデータをインポートします...")
For i As Integer = 0 To gstrTblName.Length - 1
Call subPutConsoleMsg("'" & gstrTblName(i) & "'テーブルにデータをインポートします...")
'インポートSQLを生成
Dim stbSql As System.Text.StringBuilder = New System.Text.StringBuilder("INSERT INTO " & gstrTblName(i))
Dim stbFd As System.Text.StringBuilder = New System.Text.StringBuilder(" (")
Dim stbVal As System.Text.StringBuilder = New System.Text.StringBuilder(" VALUES(")
Dim objItem(,) As Object = {}
Select Case gstrTblName(i)
Case "学級" : objItem = gobjClassItem
Case "科目" : objItem = gobjSubjectItem
Case "教師" : objItem = gobjTeacherItem
Case "生徒" : objItem = gobjStudentItem
Case "成績" : objItem = gobjRecordItem
End Select
For j As Integer = 0 To objItem.GetLength(0) - 1
If j > 0 Then
stbFd.Append(", ")
stbVal.Append(", ")
End If
stbFd.Append(objItem(j, 0))
stbVal.Append("@Item" & j.ToString)
Next j
stbSql.Append(stbFd.ToString & ")")
stbSql.Append(stbVal.ToString & ");")
Call subPutConsoleMsg("'" & gstrTblName(i) & "'テーブルインポートSQLを以下の通り生成しました...")
Call subPutConsoleMsgAndWait(stbSql.ToString)
'データのインポート
Dim objData(,) As Object = {}
Select Case gstrTblName(i)
Case "学級" : objData = gobjClassData
Case "科目" : objData = gobjSubjectData
Case "教師" : objData = gobjTeacherData
Case "生徒" : objData = gobjStudentData
Case "成績" : objData = gobjRecordData
End Select
objCmd = New OleDbCommand(stbSql.ToString, gobjDbCon)
For j As Integer = 0 To objData.GetLength(0) - 1
Console.Write(".")
'コマンドオブジェクトのパラメータを初期化
objCmd.Parameters.Clear()
For k As Integer = 0 To objData.GetLength(1) - 1
If CInt(objItem(k, 1)) = DATA_TYPE.Dt_Text Then
objCmd.Parameters.Add("@Item" & k.ToString, OleDbType.VarChar)
ElseIf CInt(objItem(k, 1)) = DATA_TYPE.Dt_Date Then
objCmd.Parameters.Add("@Item" & k.ToString, OleDbType.Date)
Else
objCmd.Parameters.Add("@Item" & k.ToString, OleDbType.Integer)
End If
objCmd.Parameters(k).Value = objData(j, k)
Next k
objCmd.ExecuteNonQuery()
Next j
Call subPutConsoleMsgAndWait(Space(1) & objData.GetLength(0).ToString & "件 完了")
'インポートしたテーブルのレコード件数を取得
If fncGetTableRecordCount(gstrTblName(i)) = False Then
blnReturn = False
Exit Try
End If
Call subPutConsoleMsg()
Next i
blnReturn = True
Catch dbex As OleDbException
'エラーが発生した場合
MsgBox(dbex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
Catch ex As Exception
'エラーが発生した場合
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
Finally
'利用したオブジェクトを破棄
objCmd.Dispose() : objCmd = Nothing
End Try
Return blnReturn
End Function
Private Function fncOperateDatabase() As Boolean
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'Accessデータベースを操作
'
' 戻り値 ： True:正常、False:異常
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim blnReturn As Boolean
Try
'データベースに接続
Dim strPath As String = IO.Path.Combine(gstrAppPath, CON_DB_FILE)
'データベース接続文字列を生成
Dim strConString As String = CON_ADO_PROVIDER & CON_ADO_DATASOURCE & strPath
'データベースコネクションオブジェクトのインスタンスを生成
gobjDbCon = New OleDbConnection(strConString)
'データベースのオープン
gobjDbCon.Open()
'データベースにテーブルを作成
If fncCreateTable() = False Then
MsgBox("テーブルの作成に失敗しました。" & ControlChars.CrLf & "アプリケーションを終了します。", MsgBoxStyle.Exclamation)
blnReturn = False
Exit Try
End If
'テーブルインデックスを作成
If fncCreateIndex() = False Then
MsgBox("インデックスの作成に失敗しました。" & ControlChars.CrLf & "アプリケーションを終了します。", MsgBoxStyle.Exclamation)
blnReturn = False
Exit Try
End If
'テーブルとフィールド、インデックス情報を確認
If fncConfirmTabelItem() = False Then
MsgBox("テーブルの確認に失敗しました。" & ControlChars.CrLf & "アプリケーションを終了します。", MsgBoxStyle.Exclamation)
blnReturn = False
Exit Try
End If
'テーブルにデータをインポート
If fncImportTable() = False Then
MsgBox("データのインポートに失敗しました。" & ControlChars.CrLf & "アプリケーションを終了します。", MsgBoxStyle.Exclamation)
blnReturn = False
Exit Try
End If
'抽出SQL例の実行
If fncExecSelectSqlExample() = False Then
MsgBox("データの抽出に失敗しました。" & ControlChars.CrLf & "アプリケーションを終了します。", MsgBoxStyle.Exclamation)
blnReturn = False
Exit Try
End If
blnReturn = True
Catch dbex As OleDbException
'エラーが発生した場合
MsgBox(dbex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
Catch ex As Exception
'エラーが発生した場合
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
Finally
'利用したオブジェクトを破棄
If Not IsNothing(gobjDbCon) Then
If Not gobjDbCon.State = ConnectionState.Closed Then
'データベースが開いている場合、データベースをクローズ
gobjDbCon.Close()
End If
gobjDbCon.Dispose()
gobjDbCon = Nothing
End If
End Try
Return blnReturn
End Function
Private Function fncStartExcel() As Boolean
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'Excelインスタンスを起動
'
' 戻り値 ： True:正常、False:異常
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim blnReturn As Boolean
Try
'Excel(Dummy)のインスタンスを起動
gobjDmyXls = New Excel.Application
gobjDmyXls.Visible = False
'Excel(アプリケーション利用)のインスタンスを起動
gobjExcel = New Excel.Application
gobjExcel.Visible = False
blnReturn = True
Catch comex As COMException
'COMエラーが発生した場合
MsgBox(comex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
Catch ex As Exception
'エラーが発生した場合
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
Finally
If blnReturn = False Then
If Not IsNothing(gobjDmyXls) Then
gobjDmyXls.Quit()
Call subMRComObject(CType(gobjDmyXls, Object))
gobjDmyXls = Nothing
End If
If Not IsNothing(gobjExcel) Then
gobjExcel.Quit()
Call subMRComObject(CType(gobjExcel, Object))
gobjExcel = Nothing
End If
End If
End Try
Return blnReturn
End Function
<DebuggerStepThrough()> _
Private Sub subMRComObject(ByRef pObject As Object)
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'COMオブジェクトの参照カウントを解放
'
' pObject ： 参照を破棄するオブジェクトのインスタンス
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
If Not IsNothing(pObject) Then
Marshal.ReleaseComObject(pObject)
End If
End Sub
<DebuggerStepThrough()> _
Private Sub subPutConsoleMsg(Optional ByVal pMsg As String = "")
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'コンソールウインドウにメッセージを表示
'
' pMsg ： 出力するメッセージ内容
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Console.WriteLine(pMsg)
End Sub
<DebuggerStepThrough()> _
Private Sub subPutConsoleMsgAndWait(Optional ByVal pMsg As String = "")
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'コンソールウインドウにメッセージを表示して待機
'
' pMsg ： 出力するメッセージ内容
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Call subPutConsoleMsg(pMsg)
Call subPutConsoleMsg("何かキーを押してください...")
Call fncGetUserEntry(True)
End Sub
Private Sub subQuitExcel()
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'Excelインスタンスの終了
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Try
'Excel(Dummy)インスタンスに開かれたブックを閉じる
If Not IsNothing(gobjDmyXls) Then
For Each objBk As Excel.Workbook In gobjDmyXls.Workbooks
'開かれているブックがある場合、ブックの保存要否はユーザに委ねる
objBk.Close()
Call subMRComObject(CType(objBk, Object))
Next
End If
'Excel(アプリケーション利用)インスタンスに開かれたブックを閉じる
If Not IsNothing(gobjExcel) Then
For Each objBk As Excel.Workbook In gobjExcel.Workbooks
Dim strFilename As String = IO.Path.Combine(gstrAppPath, My.Application.Info.AssemblyName & ".xls")
If FileIO.FileSystem.FileExists(strFilename) = True Then
'ファイルが存在する場合、既存のファイルを削除
FileIO.FileSystem.DeleteFile(strFilename)
End If
'名前を付けてアプリケーションの実行パスに保存
objBk.SaveAs(Filename:=strFilename, FileFormat:=Excel.XlFileFormat.xlExcel8)
objBk.Close()
Call subMRComObject(CType(objBk, Object))
Next
End If
Catch comex As COMException
'COMエラーが発生した場合
MsgBox(comex.Message, MsgBoxStyle.Exclamation)
Catch ex As Exception
'エラーが発生した場合
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
Finally
If Not IsNothing(gobjDmyXls) Then
gobjDmyXls.Quit()
Call subMRComObject(CType(gobjDmyXls, Object))
gobjDmyXls = Nothing
End If
If Not IsNothing(gobjExcel) Then
gobjExcel.Quit()
Call subMRComObject(CType(gobjExcel, Object))
gobjExcel = Nothing
End If
End Try
End Sub
End Module
------------------------------------------------------------
VB.NET でExcelを利用する際の注意点とExcelの挙動確認 [プログラミング]
VB.NETでExcelを利用する際に注意すべき点とそれを裏付ける挙動確認のためのコード例を紹介しよう。
VB.NETで作成したアプリケーションからExcelのインスタンスを作成して利用する場合、注意しなければいけないのはアプリケーションを実行中にユーザが既存のExcelブックを開いて何らかの作業を行う可能性だ。
なぜそれを気にしなければならないかというと、エクスプローラからExcelブックをダブルクリックして開いたりスタートメニューの最近使った項目からExcelブックを選択した際に、既存のExcelインスタンスが存在するとWindowsはそのインスタンスに対してExcelブックを開くからだ。
つまり、アプリケーションがExcelのインスタンスを作成して作業をしている最中にユーザがExcelブックを開くと、アプリケーションの作成したExcelインスタンスにそのブックが開くことになり、コードの記述内容によってはアプリケーションのExcelに対する操作をユーザに阻害されかねないと言うことだ。
そこで考えたのが、アプリケーションでExcelブックの参照や編集を行う際には、ユーザがExcelブックを操作するためのインスタンスとアプリケーションがExcelブックを操作するためのインスタンスを用意するというものだ。
ユーザがExcelブックを開いたときに利用されるExcelインスタンスが先頭のインスタンスであるなら、アプリケーションはそのインスタンスは利用せず別のExcelインスタンスを起動してそちらを利用すればアプリケーションのExcel操作をユーザに阻害される心配はなくなる。
以下の例はその考え方が正しいことを立証すると共にアプリケーション実行中にExcelブックを開いたときの挙動を確認するものだ。
簡単にコードを説明しよう。
・コンソールウインドウのサイズと表示順の設定
この例ではユーザに確認作業の指示を促すため、コンソールウインドウが常に前面に表示されるようにしている。また、確認作業の邪魔にならない程度にウインドウサイズを小さくしている。
1."GetConsoleWindow"APIを利用してコンソールウインドウのハンドルを取得する。
2.コンソールウインドウのバッファおよびウインドウサイズを設定する。
3."GetWindowRect"APIを利用してコンソールウインドウのウインドウサイズを取得する。
4."SetWindowPos"APIを利用してコンソールウインドウが常に前面に表示されるよう設定する。
・Excelインスタンスの起動
アプリケーションが実行されると二つのExcelインスタンスを起動する。一つ目のインスタンスは非表示の状態で起動し二つ目のインスタンスは表示した状態で起動する。これはExcelのインスタンスが非表示であってもユーザの開いたブックが先頭のインスタンスに開かれることを実証するためだ。
一つ目二つ目共に以下の要領でインスタンスの起動と新規ブックの作成を行っている。
1.Excelのインスタンスを起動する。
2.起動したインスタンスに新規ブックを作成する。
3.作成したブックの"Sheet1"の名称を変更し、その他のシートは削除する。
4.名称を変更した"Sheet1"の"A1"セルに「何番目のインスタンスにアプリケーションが作成したブック」なのかがわかる文言を編集する。
5.作成したブックのSavedプロパティにTrueを設定し、Excelを閉じる際にブックの保存を促されないようにする。
・Excelの挙動確認(その1)
アプリケーションが起動したExcelインスタンスのブックに対して何も操作をしていないときにユーザがExcelブックを開いたときの挙動を確認する。ユーザが開いたExcelブックがアプリケーションの起動した先頭のExcelインスタンスに開かれていることを確認し、ユーザがそのExcelを閉じた後に再度Excelブックを開いてもやはり先頭のExcelインスタンスにブックが開かれることを確認する。
1.コンソールウインドウにメッセージを表示しユーザにブックを開くことを促した後、5秒間待機する。
2.一つ目と二つ目のExcelインスタンスの"Workbooks"オブジェクトにアプリケーションが作成したブック以外のブックが開かれているかを確認し、存在した場合はそのブック名をコンソールウインドウに表示する。
3.ユーザが開いたブックが存在する場合、そのブックが開かれているExcelインスタンスが先頭のインスタンスであることの確認、確認後にそのExcelを閉じることをユーザに促す。
4.再度、上記1、2の処理を行う。
5.ユーザが開いたブックが存在する場合、そのブックが開かれているExcelインスタンスにアプリケーションの作成したブックが存在しないことの確認、確認後にユーザの開いたブックのみを閉じることをユーザに促す。
・Excelの挙動確認(その2)
アプリケーションが起動したExcelインスタンスのブックに対して編集操作をしているときにユーザがExcelブックを開いたときの挙動を確認する。ユーザが開いたExcelブックがアプリケーションの起動した先頭のExcelインスタンスに開かれていることおよびアプリケーションが作成したブックを編集中であることを確認し、ユーザがそのExcelを閉じた後に再度Excelブックを開いてもやはり先頭のExcelインスタンスにブックが開かれることおよびアプリケーションの編集操作が前の続きになっていないことを確認する。
1.Excelを編集するためのスレッドを起動する。
2.コンソールウインドウにメッセージを表示しユーザにブックを開くことを促した後、5秒間待機する。
3.一つ目と二つ目のExcelインスタンスの"Workbooks"オブジェクトにアプリケーションが作成したブック以外のブックが開かれているかを確認し、存在した場合はそのブック名をコンソールウインドウに表示する。
4.ユーザが開いたブックが存在する場合、そのブックが開かれているExcelインスタンスが先頭のインスタンスであることおよびアプリケーションの作成したブックが編集中であることの確認、確認後にそのExcelを閉じることをユーザに促す。
5.再度、上記2、3の処理を行う。
6.ユーザが開いたブックが存在する場合、そのブックが開かれているExcelインスタンスにアプリケーションの作成したブックが存在するが編集処理が先ほどの継続となっていないことの確認をユーザに促す。
・Excel編集スレッド
「Excelの挙動確認(その2)」の際にアプリケーションの作成したブックに別スレッドから編集を行う。編集処理中にブックが閉じられた場合は再度ブックを作成して編集を行う。処理は「Excelの挙動確認(その2)」が終了するまで繰り返す。
1.先頭のExcelインスタンスに作成したブックのシートのインスタンスを生成する。
2."A2"セルに「シート編集[n]回目」の文言を編集し0.5秒間待機する。(基本的にこの処理を繰り返す。)
3.COMエラーが発生した場合、先頭のExcelインスタンスにブックを再度新規作成(「Excelインスタンスの起動」の2～4の処理を実施)し自処理を回帰呼び出しして上記1、2の処理を行う。
コードの説明を読んで大まかに処理の流れは理解できただろうか。もう少し説明をしよう。
1.コードを実行するとコンソールウインドウが表示されるので、そこに表示される指示に従って操作をしていただきたい。
2.アプリケーションが二つのExcelインスタンスを起動し終えると「Excelブックを開く」指示が出るのでPC内にある既存のExcelブックを開いて欲しい。
※この後何度も「Excelブックを開く」指示があるので、その都度違うブックを開いても構わないし同じブックを何度も開いても構わない。アプリケーションを実行する前にエクスプローラを予め起動しておき利用するExcelブックが保存されたフォルダを表示しておくと良いだろう。
3.「Excelの挙動確認(その1)」では開いたExcelブックが先頭のExcelインスタンスに開かれることを実証する。(この時点ではアプリケーションは作成したブックに対して何も操作は行っていない。)
最初の指示で開いたブックが「Excel(1)」に開かれたことがコンソールウインドウに表示されるので確認していただきたい。その後、指示に従ってブックの開かれているExcelで「ウインドウの切り替え(Ctrl+Tab)」を行うとアプリケーションの作成したブックが表示されるので、"A1"セルに編集された内容でもそれが「Excel(1)」であることが確認できるだろう。もし念入りに確認したいのであれば"Alt+Tab"キーを押して、もう一つ起動されているExcelには「Excel(2)」に作成された旨が編集されたブックがあることを確認していただきたい。
※お気づきだと思うが、「Excel(1)」はアプリケーションが起動した際には「非表示」であったがユーザが既存のExcelブックを開いた際に「表示」されている。つまりこの時点でExcelインスタンスの表示/非表示にかかわらず先頭のExcelインスタンスが利用されるということが証明された。
4.開いたExcelブックが先頭のExcelインスタンスに開かれたことが確認できたらそのExcelを閉じるよう指示されるので「Excel(1)」の「×」ボタンをクリックしてExcelを閉じていただきたい。すると再度「Excelブックを開く」指示が出るので既存のExcelブックを開いて欲しい。
ここでもコンソールウインドウに開いたブックが「Excel(1)」に開かれたことが表示される。そして先ほどと同じように指示に従ってブックの開かれているExcelで「ウインドウの切り替え(Ctrl+Tab)」を行っても今度はアプリケーションの作成したブックは存在しない。何故なら先ほどExcelを閉じた際にブックを閉じてしまったからだ。(先ほどExcelを閉じた際にアプリケーションの作成したブックを保存するか否かの確認ダイアログが表示されなかったのは、アプリケーションの作成したブックはSavedプロパティをTrueに設定しているため既に保存が完了しているとExcelが認識したからだ。)
それを確認できたら指示に従って「開いたブック」だけを閉じていただきたい。何もブックの開かれていないExcelが画面に残るはずだ。
※気付いただろうか。先ほど指示に従って「Excel(1)」の「×」ボタンをクリックしてExcelを閉じたはずなのに既存のブックがまた「Excel(1)」のインスタンスに開かれていることを。ユーザ操作によりExcelブックを開いて起動したExcelインスタンスはExcelを閉じた時点で破棄されるのだが、アプリケーションが起動したExcelインスタンスはユーザがExcelを閉じても破棄されないのだ。何故ならExcelのインスタンスを起動したアプリケーションがそのインスタンスを破棄していないためだ。だからユーザが再度Excelブックを開くと先頭インスタンスである「Excel(1)」にブックが開かれることになる。但し、Excelのインスタンスは残っているがExcelを閉じる操作をしているためそこに開かれていたアプリケーションの作成したブックは閉じられてしまう。
5.続いて「Excelの挙動確認(その2)」に進む。ここでは「その1」とは異なりアプリケーションが起動した「Excel(1)」のインスタンスに開いたブックを編集中にユーザが既存のExcelブックを開いたり、Excelを閉じたらどうなるのかを確認する。
指示に従って既存のExcelブックを開いて欲しい。この時点でアプリケーションは「Excel編集スレッド」を起動してアプリケーションの作成したブックの編集を既に始めている。
6.先ほどと同様にコンソールウインドウには開いたブックが「Excel(1)」に開かれたことが表示されているはずだ。再度「ウインドウの切り替え(Ctrl+Tab)」でアプリケーションの作成したブックが存在するかを確認していただきたい。すると今度はアプリケーションの作成したブックの"A2"セルに「シート編集[n]回目」の文言が編集され"[n]"の部分が頻繁に書き換わっているのが確認できる。そう、現在このブックはアプリケーションが編集している最中なのだ。それが確認できたら指示に従って再度Excelを閉じてからもう一度Excelブックを開いていただくのだが、その前にアプリケーションが編集している文言の「[n]回目」の数字を覚えておいて欲しい。
7.またまた開いたブックは「Excel(1)」に開かれたことがコンソールウインドウに表示されるがそれは想定内だろう。そして指示に従って「ウインドウの切り替え(Ctrl+Tab)」を行うと今度はアプリケーションの作成したブックが存在し先ほどと同様に編集中のはずだ。しかし先ほどと違うのは編集中の文言が覚えておいた数字より小さくなっていることだ。(万一数字が大きい場合は6でExcelを閉じてからアプリケーションの編集内容を確認するまでをゆっくり操作していたからだろう…。)
これは何故か…答えは簡単だ。「Excel編集スレッド」には「COMエラー発生時」の処理が記述されており、エラーが発生した際には「Excel(1)」のインスタンスにブックを新規作成してから自処理を呼び出すこととしているため、ユーザ操作でExcelが閉じられたことにより消失した編集対象のブックを再作成して編集を再開しているのだ。よく考えてみるとこのエラー処理は既に前述の4→6の間でも発生しており、4の時点では存在していなかったブックが6の時点ではブックが存在し編集を行っている。
と言うことで閉じられたはずのブックが再作成された理由は理解できたと思うし、編集中の文言の数字が先ほどより小さい理由も編集処理が再呼び出しされたことによりカウンターがリセットされたからだと判ったと思う。
このアプリケーションを実行して確認できたことは、
1.ユーザ操作で開かれたExcelブックは先頭のExcelインスタンスに必ず開く。
2.アプリケーションが作成したExcelインスタンスはユーザ操作でExcelが閉じられても破棄されない。
3.アプリケーションがブックを編集中のExcelインスタンスでもユーザが既存ブックを開くと同一インスタンスにブックが開かれる。
4.アプリケーションが編集中のブックがあってもユーザ操作でExcelを閉じることができるためアプリケーションのExcel操作が阻害される。
5.アプリケーションが二つのExcelインスタンスを起動した場合、二つ目のインスタンスにはユーザ操作の影響は及ばない。
と言うことだ。
※今回は確認がしやすいようにアプリケーションがブックに対して編集操作を行った後、SavedプロパティにTrueを設定してブックを閉じる際に保存を促すダイアログが表示されないようにしているが、この設定を行わない場合はダイアログが表示されるためアプリケーションの編集操作が阻害されることに変わりはない。
※また今回は確認のため二つ目のExcelインスタンスを表示した状態で起動したが、表示されたExcelに対して既存のExcelブックをドラッグ&ドロップで開くことは可能なので、本来は非表示にしておくべきである。
以上の確認結果から、アプリケーションでExcel操作を行う場合は二つのExcelインスタンスを非表示で起動し、一つ目は予期せぬユーザ操作用に、二つ目はアプリケーションからの操作用にと使い分けるのが安全だと言うことだ。
以下の例を実行するには、新規の「コンソールアプリケーション」を作成し、"Microsoft Excel xx.x Object Library"(xx.xはお使いのExcelのバージョンによって異なる)の参照を追加した後、コードを"Module1"に貼り付けて実行すれば良い。
尚、コンソールウインドウの指示以外の操作により発生するエラーについては考慮していないのであしからず…。
------------------------------------------------------------
Imports Microsoft.Office.Interop
Imports System.Runtime.InteropServices
Module Module1
'非同期処理のデリゲート宣言
Delegate Function EditExcelDelegate() As Boolean
'定数宣言
Private Const HWND_TOPMOST _
As Integer = -1 '最前面にする
'構造体宣言
Private Structure RECT
Dim Left As Integer
Dim Top As Integer
Dim Right As Integer
Dim Bottom As Integer
End Structure
'変数宣言
Private gobjExcel1, gobjExcel2 _
As Excel.Application
Private gblnCEBQuit As Boolean
Private gstrBookName(1) As String
'非同期処理デリゲートインスタンス
Private gobjEEDelegate As EditExcelDelegate
'非同期処理戻り値
Private gobjEEReturn As IAsyncResult
'非同期処理実行中判定変数
Private gblnEEExec As Boolean
'Excel編集実行判定変数
Private gblnEEStart As Boolean
'WindowsAPI宣言
Private Declare Function GetConsoleWindow Lib _
"kernel32" () As Integer
Private Declare Function GetWindowRect Lib _
"user32.dll" (ByVal hwnd As Integer, _
ByRef lpRect As RECT) As Integer
Private Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Integer, _
ByVal hWndInsertAfter As Integer, _
ByVal x As Integer, ByVal y As Integer, _
ByVal cx As Integer, ByVal cy As Integer, _
ByVal wFlags As Integer) As Integer
Sub Main()
Try
Dim intHwnd As Integer = GetConsoleWindow
Console.SetBufferSize(80, 50)
Console.SetWindowSize(50, 10)
Dim typRect As RECT = New RECT
Call GetWindowRect(intHwnd, typRect)
Call SetWindowPos( _
intHwnd, HWND_TOPMOST, _
typRect.Left, typRect.Top, _
typRect.Right - typRect.Left, 250, 0)
'Excelのインスタンスを生成して新規ブックを作成①
Console.WriteLine( _
"一つ目のExcelを非表示で起動します...")
gobjExcel1 = New Excel.Application
gobjExcel1.Visible = False
If fncCreateExcelBook(gobjExcel1, 1) = False _
Then
MsgBox( _
"一つ目のExcelの起動に失敗しました。" & _
ControlChars.CrLf & _
"アプリケーションを終了します。", _
MsgBoxStyle.Exclamation)
Exit Try
End If
Console.WriteLine( _
"Excelの起動に成功しました...")
'Excelのインスタンスを生成して新規ブックを作成②
Console.WriteLine( _
"二つ目のExcelを表示して起動します...")
gobjExcel2 = New Excel.Application
gobjExcel2.Visible = True
If fncCreateExcelBook(gobjExcel2, 2) = False _
Then
MsgBox( _
"二つ目のExcelの起動に失敗しました。" & _
ControlChars.CrLf & _
"アプリケーションを終了します。", _
MsgBoxStyle.Exclamation)
Exit Try
End If
Console.WriteLine( _
"Excelの起動に成功しました...")
'Excelの挙動確認①
'アプリケーション待機中
Console.WriteLine("")
Console.WriteLine( _
"Excelに対して何もしていないときの挙動" & _
"を確認します...")
If fncConfirmExcelBehavior(False) = False Then
MsgBox( _
"Excelの挙動確認に失敗しました。" & _
ControlChars.CrLf & _
"アプリケーションを終了します。", _
MsgBoxStyle.Exclamation)
Exit Try
End If
'Excelの挙動確認②
'アプリケーション作業中
Console.WriteLine("")
Console.WriteLine( _
"Excelに対してシート編集中のときの挙動" & _
"を確認します...")
If fncEditExcelStart() = False Then
MsgBox( _
"Excel編集処理の起動に失敗しました。" & _
ControlChars.CrLf & _
"アプリケーションを終了します。", _
MsgBoxStyle.Exclamation)
Exit Try
End If
If fncConfirmExcelBehavior(True) = False Then
MsgBox( _
"Excelの挙動確認に失敗しました。" & _
ControlChars.CrLf & _
"アプリケーションを終了します。", _
MsgBoxStyle.Exclamation)
Exit Try
End If
Console.WriteLine( _
"Excelの挙動確認を終了しました...")
Console.WriteLine( _
"何かキーを押してください...")
Console.ReadKey(True)
Catch comex As COMException
MsgBox(comex.Message, MsgBoxStyle.Exclamation)
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
Finally
If Not IsNothing(gobjExcel1) Then
For Each objBk As Excel.Workbook _
In gobjExcel1.Workbooks
Call subBookClose(objBk, False)
Next
gobjExcel1.Quit()
Call subMRComObject(CType(gobjExcel1, _
Object))
gobjExcel1 = Nothing
End If
If Not IsNothing(gobjExcel2) Then
For Each objBk As Excel.Workbook _
In gobjExcel2.Workbooks
Call subBookClose(objBk, False)
Next
gobjExcel2.Quit()
Call subMRComObject(CType(gobjExcel2, _
Object))
gobjExcel2 = Nothing
End If
End Try
End Sub
Private Function fncConfirmExcelBehavior( _
ByVal pEdit As Boolean) As Boolean
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'Excelの挙動を確認する
'
' pEdit ： Excel編集有無判定
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim blnReturn As Boolean
Try
'Excelの挙動確認完了判定を初期化
gblnCEBQuit = False
Dim intCheck As Integer = 0
'Excelの挙動確認が完了するまで繰り返し
Do While gblnCEBQuit = False
If pEdit = True AndAlso _
gblnEEStart = False Then
'Excel編集実行判定変数を設定
gblnEEStart = True
Do While gobjExcel1.Workbooks.Count = 0
Threading.Thread.Sleep(500)
Loop
End If
Dim intCnt1 As Integer = _
gobjExcel1.Workbooks.Count
Dim intCnt2 As Integer = _
gobjExcel2.Workbooks.Count
Console.WriteLine( _
"何かExcelブックを開いてください...")
Threading.Thread.Sleep(5000)
Dim intNo As Integer = 1
For Each objBk As Excel.Workbook _
In gobjExcel1.Workbooks
If objBk.Name <> gstrBookName(0) Then
Console.WriteLine("「" & _
objBk.Name & "」が" & _
"アプリケーションの起動した" & _
"Excel(" & intNo.ToString & _
")に開かれました。")
End If
Call subMRComObject(CType(objBk, _
Object))
Next
intNo += 1
For Each objBk As Excel.Workbook _
In gobjExcel2.Workbooks
If objBk.Name <> gstrBookName(1) Then
Console.WriteLine("「" & _
objBk.Name & "」が" & _
"アプリケーションの起動した" & _
"Excel(" & intNo.ToString & _
")に開かれました。")
End If
Call subMRComObject(CType(objBk, _
Object))
Next
If intCnt1 <> gobjExcel1.Workbooks.Count _
OrElse _
intCnt2 <> gobjExcel2.Workbooks.Count _
Then
Console.WriteLine("")
If intCheck = 0 Then
'一回目の挙動確認
Console.WriteLine( _
"ブックが開かれているExcelで" & _
"Ctrl+Tabを使って")
If pEdit = False Then
Console.WriteLine( _
"アプリケーションの作成した" & _
"ブックがあること")
Console.WriteLine( _
"を確認してください...")
Else
Console.WriteLine( _
"アプリケーションの作成した" & _
"ブックが編集中で")
Console.WriteLine( _
"あることを" & _
"確認してください...")
End If
Console.WriteLine( _
"何かキーを押してください...")
Console.ReadKey(True)
Console.WriteLine( _
"ブックが開かれているExcel" & _
"を閉じてください...")
Console.WriteLine( _
"何かキーを押してください...")
Console.ReadKey(True)
intCheck += 1
ElseIf pEdit = False Then
'二回目の挙動確認(編集なし)
Console.WriteLine( _
"ブックが開かれているExcelで" & _
"Ctrl+Tabを使って")
Console.WriteLine( _
"アプリケーションの作成した" & _
"ブックがないこと")
Console.WriteLine( _
"を確認してください...")
Console.WriteLine( _
"何かキーを押してください...")
Console.ReadKey(True)
Console.WriteLine( _
"開いたブックだけ" & _
"を閉じてください...")
Console.WriteLine( _
"何かキーを押してください...")
Console.ReadKey(True)
'Excelの挙動確認完了判定を設定
gblnCEBQuit = True
Else
'二回目の挙動確認(編集あり)
Console.WriteLine( _
"ブックが開かれているExcelで" & _
"Ctrl+Tabを使って")
Console.WriteLine( _
"アプリケーションの作成した" & _
"ブックの編集が")
Console.WriteLine( _
"先ほどの続きではないことを" & _
"確認してください...")
Console.WriteLine( _
"何かキーを押してください...")
Console.ReadKey(True)
'Excel編集実行判定変数を初期化
gblnEEStart = False
'Excelの挙動確認完了判定を設定
gblnCEBQuit = True
End If
End If
Loop
blnReturn = True
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
End Try
Return blnReturn
End Function
Private Function fncCreateExcelBook( _
ByVal pExcel As Excel.Application, _
ByVal pNo As Integer) As Boolean
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'Excelのインスタンスを生成してブックを新規作成
'
' pExcel ： ブックを作成する対象のExcelのインスタンス
' pNo ： 何番目のExcelかを示す値
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim blnReturn As Boolean
Dim objBooks As Excel.Workbooks = Nothing
Dim objBook As Excel.Workbook = Nothing
Try
'Excelブックを新規作成
objBooks = pExcel.Workbooks
objBook = objBooks.Add
gstrBookName(CInt(pNo - 1)) = objBook.Name
'シートの名称変更と削除
Dim strName As String = ""
For Each objSh As Excel.Worksheet _
In objBook.Worksheets
Select Case objSh.Name
Case "Sheet1"
strName = "Excel" & pNo.ToString & _
"_" & objSh.Name
objSh.Name = strName
Case Else : objSh.Delete()
End Select
Call subMRComObject(CType(objSh, Object))
Next
'シートの編集
Dim objSheet As Excel.Worksheet = _
DirectCast(objBook.Worksheets(strName), _
Excel.Worksheet)
Dim objCells As Excel.Range = _
DirectCast(objSheet.Cells, Excel.Range)
Dim objCell As Excel.Range = _
DirectCast(objCells.Item(1, 1), Excel.Range)
objCell.Value = _
"このブックはVBアプリケーションが" & _
"起動したExcel(" & pNo.ToString & _
")に作成されたものです。"
objBook.Saved = True
'Cell、Cells、Sheetオブジェクトの破棄
Call subMRComObject(CType(objCell, Object))
objCell = Nothing
Call subMRComObject(CType(objCells, Object))
objCells = Nothing
Call subMRComObject(CType(objSheet, Object))
objSheet = Nothing
blnReturn = True
Catch comex As COMException
MsgBox(comex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
Finally
If blnReturn = False Then
'エラーが発生した場合
If Not IsNothing(objBook) Then
'ブックのインスタンスが生成されている場合はブック保存せずにを閉じる
Call subBookClose(objBook, False)
End If
End If
'Bookオブジェクトを破棄
Call subMRComObject(CType(objBook, Object))
objBook = Nothing
'Booksオブジェクトを破棄
Call subMRComObject(CType(objBooks, Object))
objBooks = Nothing
End Try
Return blnReturn
End Function
Private Function fncEditExcelStart() As Boolean
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'Excel編集処理を起動
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim blnReturn As Boolean
Try
'Excel編集処理実行中判定変数を設定
gblnEEExec = True
'Excel編集処理のデリゲートインスタンスを生成
gobjEEDelegate = New EditExcelDelegate( _
AddressOf fncEditExcelMain)
'Excel編集処理の非同期実行を開始
gobjEEReturn = gobjEEDelegate.BeginInvoke( _
New AsyncCallback( _
AddressOf subEditExcelCallback), _
Nothing)
blnReturn = True
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
'Excel編集処理実行中判定変数を設定
gblnEEExec = False
blnReturn = False
End Try
Return blnReturn
End Function
Private Function fncEditExcelMain() As Boolean
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'Excel編集メイン処理
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim blnReturn As Boolean
Try
Do
If gblnEEStart = True Then
'Excel編集実行判定がTrueの場合
Do While gblnEEStart = True
'Excel編集実行判定がTrueの間、
'Excelへの編集を実行
If fncEditExcelSub() = False Then
'Excel編集を終了
gblnEEStart = False
blnReturn = False
Exit Try
End If
Loop
Else
'Excel編集実行判定がFalseの場合
Threading.Thread.Sleep(1000)
End If
Loop
blnReturn = True
Catch ex As Exception
'エラーが発生した場合
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
End Try
Return blnReturn
End Function
Private Function fncEditExcelSub() As Boolean
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'Excel編集サブ処理
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim blnReturn As Boolean
Dim objBk As Excel.Workbook = Nothing
Dim objSh As Excel.Worksheet = Nothing
Dim objUsedRange As Excel.Range = Nothing
Dim objRows As Excel.Range = Nothing
Dim objCells As Excel.Range = Nothing
Dim objCell As Excel.Range = Nothing
Try
'Excel1のインスタンスに作成したブックのインスタンスを生成
objBk = DirectCast(gobjExcel1.Workbooks( _
gstrBookName(0)), Excel.Workbook)
'シートのインスタンスを生成
objSh = DirectCast(objBk.Worksheets(1), _
Excel.Worksheet)
objCells = DirectCast(objSh.Cells, Excel.Range)
objUsedRange = DirectCast(objSh.UsedRange, _
Excel.Range)
objRows = DirectCast(objUsedRange.Rows, _
Excel.Range)
Dim intNo As Integer = 0
Do While gblnEEStart = True
'編集済の次のセルのインスタンスを生成
objCell = DirectCast(objCells.Item( _
objRows.Count + 1, 1), Excel.Range)
intNo += 1
objCell.Value = _
"シート編集" & intNo.ToString & "回目"
objBk.Saved = True
'使用したCOMオブジェクトの破棄
Call subMRComObject(CType(objCell, Object))
objCell = Nothing
Threading.Thread.Sleep(500)
Loop
blnReturn = True
Catch comex As COMException
'COMエラーが発生した場合
'Excel1のインスタンスにブックを再作成
Call fncCreateExcelBook(gobjExcel1, 1)
'Excel編集サブ処理を回帰呼び出し
blnReturn = fncEditExcelSub()
Catch ex As Exception
'エラーが発生した場合
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
Finally
'使用したCOMオブジェクトの破棄
If Not IsNothing(objCell) Then
Call subMRComObject(CType(objCell, _
Object))
objCell = Nothing
End If
If Not IsNothing(objRows) Then
Call subMRComObject(CType(objRows, _
Object))
objRows = Nothing
End If
If Not IsNothing(objUsedRange) Then
Call subMRComObject(CType(objUsedRange, _
Object))
objUsedRange = Nothing
End If
If Not IsNothing(objCells) Then
Call subMRComObject(CType(objCells, _
Object))
objCells = Nothing
End If
If Not IsNothing(objSh) Then
Call subMRComObject(CType(objSh, _
Object))
objSh = Nothing
End If
If Not IsNothing(objBk) Then
Call subMRComObject(CType(objBk, _
Object))
objBk = Nothing
End If
End Try
Return blnReturn
End Function
Private Sub subBookClose( _
ByVal pBook As Excel.Workbook, _
ByVal pSave As Boolean)
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'ブックを閉じる
'
' pBook ： 閉じる対象のブックのインスタンス
' pSave ： ブックを保存するか否かを示す値
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Try
pBook.Close(pSave)
Catch ex As Exception
End Try
End Sub
Private Sub subEditExcelCallback( _
ByVal ar As IAsyncResult)
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'Excel編集処理のコールバック関数
'
' ar : 非同期処理情報インターフェース
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Try
Do
If gobjEEReturn.IsCompleted = True Then
'Excel編集処理が完了した場合
Dim blnReturn As Boolean = _
gobjEEDelegate.EndInvoke( _
gobjEEReturn)
If blnReturn = False Then
'異常終了メッセージを表示
MsgBox( _
"Excel編集処理で異常を" & _
"検出しました。", _
MsgBoxStyle.Exclamation)
End If
'Excel編集処理のデリゲートインスタンスを破棄
gobjEEDelegate = Nothing
'Excel編集処理の戻り値インスタンスを破棄
gobjEEReturn = Nothing
'Excel編集処理実行中判定変数を設定
gblnEEExec = False
Exit Do
Else
'Excel編集処理が実行中の場合
Threading.Thread.Sleep(250)
End If
Loop
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
End Try
End Sub
Private Sub subMRComObject(ByRef pObject As Object)
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'COMオブジェクトの参照カウントを解放
'
' pObject ： 参照を破棄するオブジェクトのインスタンス
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
If Not IsNothing(pObject) Then
Marshal.ReleaseComObject(pObject)
End If
End Sub
End Module
------------------------------------------------------------
VB.NET で構造体配列の内容をExcelに一括編集する方法 [プログラミング]
CSV形式のテキストファイルやデータベースを読み込んでExcelのシートに編集する場合、1行(レコード)ずつ処理するのは効率が悪いので配列にすべての行(レコード)を読み込んで一括編集したいものだ。
しかし、行(レコード)を一括して配列に格納すると"Column()"の形式となるため、複数の行(レコード)を配列に格納するとなると"Row()"の各要素の中に"Column()"のメンバを持つ構造体配列になるのだが、配列を一括でExcelに編集するためには配列は"Array(,)"形式の二次元配列でなければならない。
と言うことで、構造体配列を二次元配列に変換してExcelに一括編集する方法を纏めてみた。
配列の変換を大まかに説明すると、以下のようになる。
1.構造体配列(行().列())を二段階配列(配列(行)(列))に変換する。
2.二段階配列(配列(行)(列))を二次元配列(配列(列,行))に変換する。(ExcelのWorksheetFunction(行列の入れ替え)を利用)
3.二次元配列(配列(列,行))を二次元配列(配列(行,列))に変換する。(ExcelのWorksheetFunction(行列の入れ替え)を利用)
ここまでできれば後は編集したいセル範囲をRengeオブジェクトに設定し、Value2プロパティに配列を設定するだけだ。
以下の例ではCSV形式のテキストファイルまたはデータベースを構造体配列に読み込む代わりに配列を作成し、上記の要領で変換した配列を新規作成したブックに編集している。
簡単にコードを説明しよう。
・Excelの起動とブックの新規作成
VB.NETでExcelを利用するには「プロジェクト→参照の追加 COMタブより"Microsoft Excel xx.x Object Library"を追加」を行い、コードに"Microsoft.Office.Interop"のインポートが必要となる。
1.Excel.Applicationオブジェクトのインスタンスを生成してExcelを起動する。このときVisibleプロパティにFalseを指定すると非表示で起動することができる。
2.Excel.ApplicationオブジェクトのWorkbooksオブジェクトを生成し新規ブックを作成する。
※VB.NETでExcelを操作する際にはCOMオブジェクトの参照カウントの解放を意識しなければいけない。COMオブジェクトを参照し終わったら参照カウントをデクリメントしておかないとアプリケーションが終了しても起動したExcelのプロセスが残ったままになる場合があるからだ。詳しくは「vb.net excel releasecomobject」で検索。
※なので、COMオブジェクトのインスタンスを随時作成して利用し終わったら解放するといった手順が必要。
・配列をExcelに一括編集
先ほども説明したが、構造体配列を段階を踏んで二次元配列に変換した後、二次元配列に相当するセル範囲のRangeオブジェクトに編集する。
1.構造体配列(pRow().objCol())を二段階配列(objArray1()())に変換するわけだが方法は至って簡単。"objArray1()"と宣言した一次元配列に構造体配列の"pRow().objCol"を設定するだけで良い。すると先の説明の通り「構造体配列(行().列())」が「二段階配列(配列(行)(列))」になる。
2.Excel.ApplicationオブジェクトのWorksheetFunctionオブジェクトを生成しTransposeメソッドを利用して「二段階配列(配列(行)(列))"objArray1()()"」を「二次元配列(配列(列,行))"objArray2(,)"」に変換する。
3.上記2で二次元配列にすることができたが「行、列」ではなく「列、行」となっているので再度Transposeメソッドを利用して「二次元配列(配列(列,行))"objArray2(,)"」を「二次元配列(配列(行,列))"objArray3(,)"」に変換する。
4.変換した二次元配列の一次元目の要素数(行数)と二次元目の要素数(列数)から編集対象のWorksheetオブジェクトのRangeオブジェクトを生成し、Value2プロパティに"objArray3"を設定する。今回は編集先のセルの書式設定はしていないが必要に応じて配列を設定する前にセルの書式設定を行っておくと良い。
※二段階配列を二次元配列に変換する際に一つだけ注意点がある。構造体配列の要素数が一つしかない場合は当然二段階配列の一段階目も一つしか要素がない。この状態でTransposeメソッドを利用して行列を入れ替えるとエラーが発生する。理由は「行1×列n」の行列を入れ替えると「行n×列1」になるため「行n」の一次元配列になってしまうからだ。これを回避するため構造体配列から二段階配列に変換した後で二段階配列に空の要素を追加している。この追加された空の要素は二次元配列に変換しても空(Nothing)のまま存在しているが、Rangeオブジェクトに編集した際にNothingの箇所は当然のことながら何も値が設定されない。
以下の例を実行するには、新規の「コンソールアプリケーション」を作成し、先に記述した通り"Microsoft Excel xx.x Object Library"(xx.xはお使いのExcelのバージョンによって異なる)の参照を追加した後、コードを"Module1"に貼り付けて実行すれば良い。
Excelが起動し新規ブックを作成した後、コンソールウインドウに編集対象の配列の内容が出力される。画面の指示に従い何かキーを押すとExcelの1シート目に「10行×4列」の配列の値が編集される。更に画面の指示に従い何かキーを押すと2シート目に「1行×4列」の配列の値が編集される。最後にメッセージボックスの内容を確認して「OK」ボタンを押下するとブックを保存せずにExcelが終了してアプリケーションも終了する。
------------------------------------------------------------
Imports System.Runtime.InteropServices
Imports Microsoft.Office.Interop
Module Module1
'型宣言
'行の要素
Private Structure COL_ARRAY
Dim objCol() As Object
End Structure
'変数宣言
Private gobjExcel As Excel.Application
Private gobjBook As Excel.Workbook
Private gobjSheet() As Excel.Worksheet
Private Declare Function GetConsoleWindow Lib _
"kernel32" () As Integer
Private Declare Function SetForegroundWindow Lib _
"user32" Alias "SetForegroundWindow" _
(ByVal hwnd As Integer) As Integer
Sub Main()
'Excelのインスタンスを生成してブックを新規作成
Console.WriteLine("Excelを起動します...")
Dim intHwnd As Integer = GetConsoleWindow
If fncCreateExcelBook() = False Then
MsgBox("Excelの起動に失敗しました。" & _
ControlChars.CrLf & _
"アプリケーションを終了します。", _
MsgBoxStyle.Exclamation)
Exit Sub
End If
Try
Call SetForegroundWindow(intHwnd)
'配列の準備
Console.WriteLine( _
"配列(typRow1)を以下の通り作成します...")
Dim typRow1(9) As COL_ARRAY
For i As Integer = 0 To 9
typRow1(i).objCol = {"文字列1-" & _
(i + 1).ToString, _
1 * (i + 1), _
"文字列2-" & _
(i + 1).ToString, _
10 * (i + 1)}
Console.WriteLine("typRow1(" & _
i.ToString & ") ... " & _
Join(typRow1(i).objCol, ","))
Next i
Console.WriteLine( _
"配列(typRow2)を以下の通り作成します...")
Dim typRow2(0) As COL_ARRAY
typRow2(0).objCol = {"文字列1", 1, "文字列2", _
10}
Console.WriteLine("typRow2(0) ... " & _
Join(typRow2(0).objCol, ","))
Console.WriteLine( _
"配列(typRow1)をシートに編集します..." & _
"何かキーを押してください...")
Console.ReadKey(True)
'配列1(typRow1)をExcelに編集
If fncEditExcel(typRow1, 0) = False Then
MsgBox("配列1(typRow1)のExcel編集に" & _
"失敗しました。" & _
ControlChars.CrLf & _
"アプリケーションを終了します。", _
MsgBoxStyle.Exclamation)
Exit Try
End If
Console.WriteLine( _
"配列(typRow2)をシートに編集します..." & _
"何かキーを押してください...")
Console.ReadKey(True)
'配列2(typRow2)をExcelに編集
If fncEditExcel(typRow2, 1) = False Then
MsgBox("配列1(typRow2)のExcel編集に" & _
"失敗しました。" & _
ControlChars.CrLf & _
"アプリケーションを終了します。", _
MsgBoxStyle.Exclamation)
Exit Try
End If
MsgBox("配列のExcel一括編集が完了しました。" & _
ControlChars.CrLf & _
"OKボタンを押下するとExcelを閉じて" & _
"アプリケーションを終了します。", _
MsgBoxStyle.Information)
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
Finally
'ブックを閉じる(保存しない)
If Not IsNothing(gobjBook) Then
Call subBookClose()
Call subMRComObject(CType(gobjBook, Object))
gobjBook = Nothing
End If
'Excelを閉じる
If Not IsNothing(gobjExcel) Then
gobjExcel.Quit()
Call subMRComObject(CType(gobjExcel, Object))
gobjExcel = Nothing
End If
End Try
End Sub
Private Function fncCreateExcelBook() As Boolean
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'Excelのインスタンスを生成してブックを新規作成
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim blnReturn As Boolean
Try
'Excelのインスタンスを生成
gobjExcel = New Excel.Application
gobjExcel.Visible = True
'Excelブックを新規作成
Dim objBooks As Excel.Workbooks = _
gobjExcel.Workbooks
gobjBook = objBooks.Add
'Booksオブジェクトを破棄
Call subMRComObject(CType(objBooks, Object))
objBooks = Nothing
'シートの作成と削除
ReDim gobjSheet(1)
For Each objSh As Excel.Worksheet _
In gobjBook.Worksheets
Select Case objSh.Name
Case "Sheet1"
objSh.Name = "配列(typRow1)"
gobjSheet(0) = DirectCast( _
gobjBook.Worksheets(objSh.Name), _
Excel.Worksheet)
Case "Sheet2"
objSh.Name = "配列(typRow2)"
gobjSheet(1) = DirectCast( _
gobjBook.Worksheets(objSh.Name), _
Excel.Worksheet)
Case Else : objSh.Delete()
End Select
Call subMRComObject(CType(objSh, Object))
Next
For i As Integer = 0 To gobjSheet.Length - 1
If IsNothing(gobjSheet(i)) Then
'シートのインスタンスが設定されていない場合、ブックにシートを追加
gobjSheet(i) = DirectCast( _
gobjBook.Worksheets.Add( _
After:=gobjBook.Worksheets.Count), _
Excel.Worksheet)
gobjSheet(i).Name = _
"配列(typRow" & i + 1 & ")"
End If
Next i
blnReturn = True
Catch comex As COMException
MsgBox(comex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
Finally
If blnReturn = False Then
If Not IsNothing(gobjBook) Then
Call subBookClose()
Call subMRComObject(CType(gobjBook, Object))
gobjBook = Nothing
End If
If Not IsNothing(gobjExcel) Then
gobjExcel.Quit()
Call subMRComObject(CType(gobjExcel, Object))
gobjExcel = Nothing
End If
End If
End Try
Return blnReturn
End Function
Private Function fncEditExcel( _
ByRef pRow() As COL_ARRAY, _
ByVal pIndex As Integer) As Boolean
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'配列をExcel編集可能な二次元配列に変換して編集
'
' pRow() ： 変換対象の配列
' pIndex ： 編集対象シートの配列番号
'
' Return ： True:正常、False:異常
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim blnReturn As Boolean
Dim objCells As Excel.Range = _
DirectCast(gobjSheet(pIndex).Cells, _
Excel.Range)
Try
'配列を二段階配列に変換
'pRow().objCol()→objArray1()()に変換する
Dim objArray1(0) As Object
For i As Integer = 0 To pRow.Length - 1
If Not IsNothing( _
objArray1(objArray1.Length - 1)) Then
ReDim Preserve _
objArray1(objArray1.Length)
End If
objArray1(objArray1.Length - 1) = _
pRow(i).objCol
Next i
If objArray1.Length = 1 Then
'二段階配列の要素数が1の場合、二段階配列にダミー要素を追加
'※ 要素数1の場合、行列の入れ替えで配列の次元数が減少することの対策
'※ 追加したダミーの配列はNothingのため、Excelに編集する際に無視される
Dim objDummy(pRow(0).objCol.Length - 1) _
As Object
ReDim Preserve objArray1(objArray1.Length)
objArray1(objArray1.Length - 1) = objDummy
End If
'二段階配列の行列を入れ替えて二次元配列に変換
'objArray1(R)(C)→objArray2(C,R)に変換
Dim objFunc As Excel.WorksheetFunction = _
DirectCast(gobjExcel.WorksheetFunction, _
Excel.WorksheetFunction)
Dim objArray2(,) As Object = _
CType(objFunc.Transpose(objArray1), _
Object(,))
'変換した二次元配列の行列を再度入れ替えて行列を元に戻す
'objArray2(C,R)→objArray3(R,C)に変換
Dim objArray3(,) As Object = _
CType(objFunc.Transpose(objArray2), _
Object(,))
'WorksheetFunctionオブジェクトを破棄
Call subMRComObject(CType(objFunc, Object))
objFunc = Nothing
gobjSheet(pIndex).Activate()
'配列を編集するセル範囲を設定
Dim objRange As Excel.Range = DirectCast( _
objCells.Range(objCells.Item(1, 1), _
objCells.Item(objArray3.GetLength(0), _
objArray3.GetLength(1))), Excel.Range)
'配列を編集
objRange.Value2 = objArray3
'Rangeオブジェクトを破棄
Call subMRComObject(CType(objRange, Object))
objRange = Nothing
blnReturn = True
Catch comex As COMException
MsgBox(comex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
Finally
'Cellsオブジェクトを破棄
Call subMRComObject(CType(objCells, Object))
objCells = Nothing
End Try
Return blnReturn
End Function
Private Sub subBookClose()
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'ブックを閉じる
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Try
gobjBook.Close(False)
Catch ex As Exception
End Try
End Sub
Private Sub subMRComObject(ByRef pObject As Object)
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'COMオブジェクトの参照カウントを解放
'
' pObject ： 参照を破棄するオブジェクトのインスタンス
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
If Not IsNothing(pObject) Then
Marshal.ReleaseComObject(pObject)
End If
End Sub
End Module
------------------------------------------------------------
VB.NET でスレッドセーフで非同期処理からフォームのコントロールを更新する方法 [プログラミング]
「Windowsフォームアプリケーション」でマルチスレッドを実装した場合、フォームと異なるスレッドで実行している非同期処理からフォームのコントロールのプロパティを更新したいことがある。
しかし、フォームと異なるスレッドから「TextBox.Text = "aaaa"」のようなプロパティの更新は行えないため、スレッドセーフで更新を行うためのメソッドが必要となる。
以下の例ではフォームの「実行」ボタンを押下すると非同期デリゲートを利用した非同期処理が別スレッドで実行され、フォームのテキストボックスに処理の経過を出力する。
その際、ユーザの誤操作を防止するために「実行」ボタンを非活性にすると共に、フォームの「閉じる」ボタンおよびコントロールメニューからの「閉じる」操作が行われてもフォームを閉じることができないように対策している。
簡単にコードの説明をしよう。(非同期デリゲートを利用した非同期処理に関するコードは別途説明済みなので割愛する。)
・コールバック関数の宣言
コードの先頭に宣言されている"Delegate"ステートメントは、ボタンのEnabledプロパティ、フォームのTagプロパティ、テキストボックスのTextプロパティをスレッドセーフで更新するためのコールバック関数で、これらの関数は各々の更新を行うメソッドで利用する。
・コントロールをスレッドセーフで更新するためのメソッド
"subButtonEnabledSet"、"subFormTagSet"、"subTextBoxTextSet"がそのためのメソッドで対象は各々異なるが処理内容は変わらない。"subButtonEnabledSet"メソッドを例にとって説明する。
1.このメソッドの引数には"[Button]"と"[Value]"が宣言されており、この引数は"Delegate"ステートメントに宣言したコールバック関数の引数と一致している必要がある。一つ目の"[Button]"には更新の対象となるボタンコントロールのインスタンスを、二つ目の"[Value]"にはEnabledプロパティに設定する値を受け取る引数を指定する。
2.引数で受け取った"[Button]"をそのまま利用しても問題ないが、メソッド内に宣言した"oControl"に引数の"[Button]"を代入する。
3.引数で受け取った"[Button]"コントロールをスレッドセーフで更新する必要があるか否かをInvokeRequiredプロパティで確認する。この値がTrueならばこのコントロールは別スレッドで作成されたコントロールであるためInvokeメソッドを使用してスレッドセーフで更新する必要がある。但し、コントロールのハンドルがまだ作成されていない場合はInvokeRequiredプロパティはFalseを返す可能性があるため、その場合はコールバック関数を呼び出す必要はない。
4.スレッドセーフで更新する必要があると判断された場合、コールバック関数のインスタンスを生成して引数で受け取った"[Button]"コントロールのInvokeメソッドの呼び出しに利用する。
5.スレッドセーフで更新する必要がないと判断された場合は、引数で受け取った"[Button]"コントロールのEnabledプロパティに引数で受け取った"[Value]"を設定すれば良い。
・「実行」ボタンを押下時の処理
1.非同期デリゲートのインスタンスを生成して非同期処理"fncThread"を実行する。
2.非同期処理の起動が成功したらフォームのTagプロパティに「実行中」の文字列を設定し、「実行」ボタンのEnabledプロパティにFalseを設定してボタンを非活性にする。ここでフォームのTagプロパティに「実行中」の文字列を設定するのは非同期処理中にフォームが閉じられるのを防止するためで設定する値は何でも良い。また、ボタンを非活性にするのは非同期処理の実行中に再度「実行」ボタンが押下されるのを防止するためである。
・非同期処理("fncThread")
ここでは非同期処理が起動されてから10秒間、フォームのテキストボックスに処理経過を出力する。
1.現在日時に10秒を加算した日時の変数を生成する。
2.現在時刻が上記1で生成した日時未満の間、フォームのテキストボックスの値を取得し「非同期処理中...[現在時刻]("hh:mm:ss"形式)」の文字列を追加してフォームのテキストボックスを更新する。その際、テキストボックスの値の取得時は通常通り「strValue = txtResult.Text」で問題ないが、更新時は"subTextBoxTextSet"メソッドを呼び出してスレッドセーフで処理を行う。尚、今回は値の取得を行うコントロールがテキストボックスであるため取得時に特に考慮をしていないが、対象のコントロールによってはプロパティの参照時もスレッドセーフを考慮する必要がある。
・非同期処理のコールバック関数の処理
ここでは非同期処理の終了を検出して非同期処理が終了したことを通知すると共にフォームのTagプロパティとボタンのEnabledプロパティの更新を各々スレッドセーフで行う。
・非同期処理実行中にフォームが閉じられるのを防止する
フォームのFormClosingイベントでユーザがフォームを閉じようとしている操作をキャッチし、非同期処理実行中の場合はフォームを閉じないようにする。
フォームのFormClosingイベントで引数に渡されるFormClosingEventArgsのCloseReasonプロパティを確認するとフォームが閉じられる理由が判る。この値がCloseReason.UserClosingであればユーザがフォームを閉じようとしているため、フォームのTagプロパティに「実行中」の文字列が設定されていれば非同期処理の実行中なのでFormClosingEventArgsのCancelプロパティにTrueを設定してフォームのクローズイベントをキャンセルする。
以下の例を実行するには、新規の「Windowsフォームアプリケーション」を作成しフォームのデザインで"Button"と"TextBox"コントロールをフォームに配置して、コードを"Form1"に貼り付けて実行すれば良い。
尚、"Button"コントロールのNameプロパティには"btnExec"をTextプロパティには"実行"を設定し、"TextBox"コントロールのMultilineプロパティにはTrueをNameプロパティには"txtResult"をScrollBarsプロパティにはVerticalを設定する。
プログラムを実行するとフォームが表示されるので、「実行」ボタンを押下すると非同期処理が起動してテキストボックスに処理経過が表示される。非同期処理の実行中にフォームの「閉じる」ボタンを押下しても「処理実行中にウインドウを閉じることはできません。」のメッセージボックスが表示されフォームを閉じることはできない。
今回はスレッドセーフでフォームのコントロールのプロパティを更新する方法を記載したが、同様の方法でメソッドを実行することも可能である。(例えばフォームのCloseメソッドなど…。)
また、フォームのコントロールのプロパティの値を取得する場合もほぼ同様の方法で可能だ。但し、その場合は取得した値を戻り値として戻すためSubプロシージャではなくFunctionプロシージャとする必要がある。
------------------------------------------------------------
Public Class Form1
'スレッドセーフのコールバック関数
Delegate Sub subButtonEnabledSetCallBack( _
ByVal [Button] As Button, _
ByVal [Value] As Boolean)
Delegate Sub subFormTagSetCallBack( _
ByVal [Value] As String)
Delegate Sub subTextBoxTextSetCallBack( _
ByVal [TextBox] As TextBox, _
ByVal [Text] As String)
'非同期処理のデリゲート宣言
Delegate Function Thread1Delegate() As Boolean
'ユーザ定義変数
'非同期処理デリゲートインスタンス
Private gobjThread1Delegate As Thread1Delegate
'非同期処理戻り値
Private gobjThread1Return As IAsyncResult
Private Sub Form1_FormClosing(sender As Object, _
e As System.Windows.Forms.FormClosingEventArgs) _
Handles Me.FormClosing
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'フォームが閉じられる時の処理
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Select Case e.CloseReason
Case CloseReason.UserClosing
'コントロールメニューから閉じるを選択
If Me.Tag.ToString = "実行中" Then
'処理実行中の場合、終了操作をキャンセル
MsgBox("処理実行中にウインドウを" & _
"閉じることはできません。", _
MsgBoxStyle.Critical)
e.Cancel = True
Exit Sub
End If
End Select
End Sub
Private Sub Form1_Load(sender As Object, _
e As System.EventArgs) Handles Me.Load
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'フォームロード時の処理
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Me.Tag = ""
End Sub
Private Sub btnExec_Click(sender As Object, _
e As System.EventArgs) Handles btnExec.Click
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'実行ボタン押下時の処理
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'テキストボックスの初期化
txtResult.Text = "非同期処理を開始..." & _
ControlChars.CrLf
Try
'非同期処理の開始
'非同期処理①のデリゲートインスタンスを生成
gobjThread1Delegate = New Thread1Delegate( _
AddressOf fncThread)
'非同期処理①の非同期実行を開始
gobjThread1Return = _
gobjThread1Delegate.BeginInvoke( _
New AsyncCallback( _
AddressOf subThreadCallback), _
Nothing)
'フォームのTagプロパティを設定
Me.Tag = "実行中"
'ボタンの動作設定
btnExec.Enabled = False
Catch ex As Exception
'非同期処理の実行に失敗した場合
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
End Try
End Sub
Private Function fncThread() As Boolean
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'非同期処理
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim blnReturn As Boolean
Try
'一定間隔でフォームのテキストボックスに経過を出力
Dim dTime As Date = Now.AddSeconds(10)
Do While dTime > Now
'テキストボックスのTextプロパティを取得
Dim strValue As String = txtResult.Text
If strValue <> "" Then
'記入済ならば改行文字を追加
strValue = strValue & ControlChars.CrLf
End If
strValue = strValue & "非同期処理中..." & _
Now.ToString("hh:mm:ss")
'スレッドセーフでテキストボックスの
'Textプロパティを更新
Call subTextBoxTextSet(txtResult, strValue)
'1秒待機
System.Threading.Thread.Sleep(1000)
Loop
'非同期処理の戻り値を設定
blnReturn = True
Catch ex As Exception
'エラーが発生した場合
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
blnReturn = False
End Try
Return blnReturn
End Function
Public Sub subThreadCallback(ByVal ar As IAsyncResult)
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'非同期処理のコールバック関数
'
' ar : 非同期処理情報インターフェース
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Try
Do
If gobjThread1Return.IsCompleted = True Then
'非同期処理①が完了した場合
Dim blnReturn As Boolean = _
gobjThread1Delegate.EndInvoke( _
gobjThread1Return)
If blnReturn = False Then
'異常終了メッセージを表示
MsgBox("非同期処理で異常を検出" & _
"しました。", _
MsgBoxStyle.Exclamation)
End If
'非同期処理のデリゲートインスタンスを破棄
gobjThread1Delegate = Nothing
'非同期処理の戻り値インスタンスを破棄
gobjThread1Return = Nothing
'テキストボックスのTextプロパティを取得
Dim strValue As String = txtResult.Text
If strValue <> "" Then
'記入済ならば改行文字を追加
strValue = strValue & _
ControlChars.CrLf
End If
strValue = strValue & _
ControlChars.CrLf & _
"非同期処理を終了..."
'スレッドセーフでテキストボックスの
'Textプロパティを更新
Call subTextBoxTextSet(txtResult, _
strValue)
'スレッドセーフでフォームの
'Tagプロパティを更新
Call subFormTagSet("")
'スレッドセーフでボタンの
'Enabledプロパティを更新
Call subButtonEnabledSet(btnExec, True)
Exit Do
Else
'非同期処理が実行中の場合
System.Threading.Thread.Sleep(250)
End If
Loop
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Exclamation)
End Try
End Sub
Public Sub subButtonEnabledSet(ByVal [Button] As Button, _
ByVal [Value] As Boolean)
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'ボタンのEnabledプロパティを設定
'
' Button : 設定するボタンのインスタンス
' Value : 設定するEnabledプロパティの値
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim oControl As Button = [Button]
'スレッドセーフで実行する必要があるか否かをチェック
If oControl.InvokeRequired = True Then
'スレッドセーフで実行する必要がある場合
Dim d As New subButtonEnabledSetCallBack( _
AddressOf subButtonEnabledSet)
oControl.Invoke(d, New Object() {[Button], _
[Value]})
Else
'スレッドセーフで実行する必要がない場合
oControl.Enabled = [Value]
End If
End Sub
Public Sub subFormTagSet(ByVal [Value] As String)
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'フォームのタグを設定
'
' Value : タグに設定する値
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'スレッドセーフで実行する必要があるか否かをチェック
If Me.InvokeRequired = True Then
'スレッドセーフで実行する必要がある場合
Dim d As New subFormTagSetCallback( _
AddressOf subFormTagSet)
Me.Invoke(d, New Object() {[Value]})
Else
'スレッドセーフで実行する必要がない場合
Me.Tag = [Value]
End If
End Sub
Public Sub subTextBoxTextSet(ByVal [TextBox] As TextBox, _
ByVal [Text] As String)
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
'テキストボックスのTextプロパティを設定
'
' TextBox : 設定するテキストボックスの
' インスタンス
' Text : 設定するTextプロパティの値
'
'＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊＊
Dim oControl As TextBox = [TextBox]
'スレッドセーフで実行する必要があるか否かをチェック
If oControl.InvokeRequired = True Then
'スレッドセーフで実行する必要がある場合
Dim d As New subTextBoxTextSetCallBack( _
AddressOf subTextBoxTextSet)
oControl.Invoke(d, New Object() {[TextBox], _
[Text]})
Else
'スレッドセーフで実行する必要がない場合
oControl.Text = [Text]
End If
End Sub
End Class
------------------------------------------------------------