カテゴリー
SugiBlog ホームページ制作・システム開発|大阪

Shell起動したアプリケーションの終了を待つ

Dim oShell As Object, oExec As Object

'オブジェクト変数に参照をセットします
Set oShell = CreateObject("WScript.Shell")
Set oExec = oShell.Exec("C:\example.exe")

'処理完了を待機
Do Until oExec.Status: DoEvents: Loop

'戻り値をセット
If Not oExec.StdErr.AtEndOfStream Then
	ExecCommand = True
	sResult = oExec.StdErr.ReadAll
ElseIf Not oExec.StdOut.AtEndOfStream Then
	sResult = oExec.StdOut.ReadAll
End If

'オブジェクト変数の参照を解放
Set oExec = Nothing: Set oShell = Nothing

'結果を表示
MsgBox sResult
2,820 views

レコードの検索【FindRecord】

DoCmd.FindRecord [FindWhat], [Match]

例1)

DoCmd.GoToControl "[検索するフィールドのコントロール]"
DoCmd.FindRecord "[検索する文字列]", [検索タイプ]

例2)

[検索するフィールドのコントロール].SetFocus
DoCmd.FindRecord "[検索する文字列]", [検索タイプ]

[検索タイプ]
acEntire=完全一致
acAnywhere=部分一致
acStart=検索文字列で始まる

3,722 views

VBA ディレクトリ内の全ファイルを読み込む

Visual BasicでFileSystemObjectを使用し、
指定したディレクトリ内の全ファイル(サブディレクトリを含む)を読み込む。
全階層を再帰的に検索することができます。

■コマンドボタンに以下のようにコードを記述

Private Sub ファイル検索_Click()

    Dim strPath As String
    Dim fsObj As Object

    If Not IsNull("検索文字列") Then

        Set fsObj = CreateObject("Scripting.FileSystemObject")

        strPath = "調べたいディレクトリまでのフルパス"
        strKey = "検索文字列"

        'ディレクトリ読み込み関数を呼び出し
        Call SearchSubDirectory(fsObj.GetFolder(strPath), strKey)

        'オブジェクトを破棄
        Set fsObj = Nothing

    End If

End Sub

続きを読む…»

11,017 views

参照設定を追加せずDAOを利用する

Dim db As Object
Dim rst As Object

Set db = DBEngine.Workspaces(0).Databases(0)

MsgBox db.Name

Set rst = db.OpenRecordset("テーブルまたはクエリ名")

Do Until rst.EOF
    Debug.Print rst("フィールド名")
    DoEvents
    rst.MoveNext
Loop

rst.Close: Set rst = Nothing
db.Close: Set db = Nothing

OpenRecordsetメソッドにdbOpenDynasetなどの引数を指定したい場合
定数が使用できないので、下記を参考に数値を入力してください。

dbOpenTable 1
dbOpenDynamic 2
dbOpenDynaset 3
dbOpenSnapshot 4

SQL Serverへ接続する場合について(※2016.06.14追記)

SQL ServerのID列を持つテーブルを開くときは、dbSeeChanges(512)オプションを使用するようエラーが発生します。
その場合は以下のように開きます。

Set rst = db.OpenRecordset("テーブルまたはクエリ名", 2, 512)
3,697 views

ファイルのバージョン情報を取得

FileSystemObjectを使用する場合、例のようにCreateObjectを利用するか
[ツール]-[参照設定]で[Microsoft Scripting Runtime]の参照追加が必要。

Function get_file_version(ByVal strFilePath As String) As String

    Dim cFSO      As Object
    Dim stVersion As String

    'FileSystemObjectのインスタンスを生成
    Set cFSO = CreateObject("Scripting.FileSystemObject")

    'ファイルのバージョンを取得する
    stVersion = cFSO.GetFileVersion(strFilePath)

    'オブジェクト破棄
    Set cFSO = Nothing

    get_file_version = stVersion

End Function
7,542 views

マウスポインター形状の変更

ACCESS VBAにてマウスポインターの形状を変更するには

通常の砂時計などは、用意されたプロパティ・メソッドで変更可能

例)

DoCmd.Hourglass True    '砂時計ポインターにする
Screen.MousePointer = 9 '左右の矢印にする
Screen.MousePointerに設定できるその他の値
既定値 0
矢印 1
I字型 3
上下の矢印 7
左右の矢印 9
砂時計 11

上記以外の形状に変更したい場合

Win32 APIを使用

General部分にAPI関数を定義(モジュールに書く場合はPublicを使用)

Private Declare Function LoadCursor Lib "user32" Alias "LoadCursorA" _
  (ByVal hInstance As Long, ByVal lpCursorName As Long) As Long
Private Declare Function SetCursor Lib "user32" _
  (ByVal hCursor As Long) As Long

ハンドカーソルの定数を定義

Private Const IDC_HAND = 32649& 'ハンドカーソル

マウスカーソルの戻り値(形状)格納用

Private mCursor As Long

フォーム起動時に、ハンドカーソルを取得

Private Sub Form_Load(Cancel As Integer)
  'マウスポインターを手の形にするためのマウスカーソルを取得
  mCursor = LoadCursor(0&, IDC_HAND)
End Sub

マウスオーバー時、マウスポインターをハンドカーソルにしたいコントロールの「マウスボタン移動時」イベントに以下の処理を記述

Private Sub Label_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  'ラベル上でマウスを手の形にする
  Call SetCursor(mCursor)
End Sub
LoadCursorの第2引数の値
APIでの値(定数) VBAでの値 マウスカーソルの形
IDC_APPSTARTING 32650& 小さい砂時計付の矢印カーソル
IDC_ARROW 32512& 標準の矢印カーソル
IDC_CROSS 32515& 十字カーソル
IDC_HAND 32649& ハンドカーソル
IDC_HELP 32651& 疑問符付の矢印カーソル
IDC_IBEAM 32513& I(縦線)カーソル
IDC_NO 32648& 禁止カーソル
IDC_SIZEALL 32646& 4方向の矢印カーソル
IDC_SIZENESW 32643& 右斜め上の両方向き矢印カーソル
IDC_SIZENS 32645& 上下の両方向き矢印カーソル
IDC_SIZENWSE 32642& 右斜め下の両方向き矢印カーソル
IDC_SIZEWE 32644& 左右の両方向きカーソル
IDC_UPARROW 32516& 上向きの垂直矢印カーソル
IDC_WAIT 32514& 砂時計カーソル
Win32 APIの定数はVBAではそのまま使用できないので、定数として宣言して使用します。
例)
Public Const IDC_APPSTARTING = 32650&
19,229 views

簡易クリップボード操作

クリップボードにコピー

[control name].SetFocus
[control name].SelStart = 0
[control name].SelLength = Len([control name])
DoCmd.RunCommand acCmdCopy

クリップボードからペースト

DoCmd.RunCommand acCmdPaste

※貼り付けたデータをすぐに加工等する場合は、Me.Refreshなどでデータを一旦反映させることが必要である。

2,810 views

VBA Excelシートを別ファイルにコピー

'# Excel作成
Public Sub mkExcel_withInvoice()
On Error GoTo Exception

 Dim xl As Object
 Dim xl2 As Object
 Dim TempPath As String
 Dim Template As String
 Dim SavePath As String
 Dim FileName As String
 TempPath = "C:\"
 Template = TempPath & "雛型.xls"
 SavePath = Environ("USERPROFILE") & "\デスクトップ\"
 FileName = SavePath & "シートを別ファイルにコピー.xls"

 FileCopy Template, FileName

 Set xl = GetObject(FileName, "Excel.Sheet")
 xl.Parent.Windows(1).Visible = True

続きを読む…»

6,019 views

SQL実行

DoCmd.RunSQL "SQL Statement"[, UserTransaction=True]
1,533 views

PCが起動しているかを調べる

Private Sub Example()

  If PingResult("192.168.1.1") = False Then
    MsgBox "PCが起動していません。"
  Else
    MsgBox "PCは起動しています。"
  End If

End Sub

Function PingResult(strHostname As String)

  Dim objWMIService As Object, objStatus As Variant

  Set objWMIService = _
    GetObject("winmgmts:{impersonationLevel=impersonate}"). _
    ExecQuery("select * from Win32_PingStatus where address = '" & _
    strHostname & "'", , 48)

  For Each objStatus In objWMIService
    If IsNull(objStatus.StatusCode) Or objStatus.StatusCode <> 0 Then
      PingResult = False
    Else
      PingResult = True
    End If
  Next

End Function
4,093 views