VB・VBA – 最北端で暮らすSEのknowhow

2012年9月11日

VBでテキストデータの読み書き

Dim stream As Object
Set stream = CreateObject("ADODB.Stream")

'読取専用(1), 書込専用(2), 読み書き(3)
'他のUser読取拒否(4), 他のUser書込拒否(8), 他のUser読書拒否(12), 他のUser読書許可(16)
stream.Mode = 3

'Text(2), Binary(1)
stream.Type = 2

'(Shift_JIS, Unicode)
stream.Charset = "utf-8"

'CR(13), LF(10), CRLF(-1)
stream.LineSeparator = -1

stream.Open

'【書き込みの場合】
'一行(1), 全行(0)
stream.WriteText "テストテキスト", 1
'上書きしない(1), 上書き(2)
stream.SaveToFile "D:\test.txt", 2

'【読み取りの場合】
'stream.LoadFromFile "C:\test.txt"
'Do Until stream.EOS = True
    '一行(-2), 全行(-1)
    'Debug.Print stream.ReadText(-2)
'Loop

stream.Close
Set stream = Nothing

2011年7月7日

VBでファイルを開く・保存ダイアログ

WindowsAPIを使用する


#If VBA7 Then
    Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
    Private Declare PtrSafe Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
    Private Type OPENFILENAME
        lStructSize As Long
        hwndOwner As LongPtr
        hInstance As LongPtr
        lpstrFilter As String
        lpstrCustomFilter As String
        nMaxCustFilter As Long
        nFilterIndex As Long
        lpstrFile As String
        nMaxFile As Long
        lpstrFileTitle As String
        nMaxFileTitle As Long
        lpstrInitialDir As String
        lpstrTitle As String
        flags As Long
        nFileOffset As Integer
        nFileExtension As Integer
        lpstrDefExt As String
        lCustData As Long
        lpfnHook As LongPtr
        lpTemplateName As String
    End Type
#Else
    Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
    Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
    Private Type OPENFILENAME
        lStructSize As Long
        hwndOwner As Long
        hInstance As Long
        lpstrFilter As String
        lpstrCustomFilter As String
        nMaxCustFilter As Long
        nFilterIndex As Long
        lpstrFile As String
        nMaxFile As Long
        lpstrFileTitle As String
        nMaxFileTitle As Long
        lpstrInitialDir As String
        lpstrTitle As String
        flags As Long
        nFileOffset As Integer
        nFileExtension As Integer
        lpstrDefExt As String
        lCustData As Long
        lpfnHook As Long
        lpTemplateName As String
    End Type
#End If

Private Const OFN_HIDEREADONLY = &H4        '読み取り専用オプションを非表示
Private Const OFN_FILEMUSTEXIST = &H1000    'ファイルの存在確認

Public Function fileOpenDialog(ByVal hwnd As Long, ByVal initialDirectory As String, ByVal initialFileName As String, ParamArray fileFilters() As Variant) As String
    Dim openFile As OPENFILENAME
    Dim result As Long
    fileOpenDialog = ""
    openFile.lpstrFilter = createFilterString(fileFilters)
    openFile.nFilterIndex = 1
    openFile.hwndOwner = hwnd
    openFile.lpstrFile = String(201, 0)
    #If VBA7 Then
        openFile.nMaxFile = LenB(openFile.lpstrFile) - 1
        openFile.lStructSize = LenB(openFile)
    #Else
        openFile.nMaxFile = Len(openFile.lpstrFile) - 1
        openFile.lStructSize = Len(openFile)
    #End If
    openFile.lpstrFileTitle = openFile.lpstrFile
    openFile.nMaxFileTitle = openFile.nMaxFile
    openFile.lpstrInitialDir = initialDirectory
    openFile.lpstrFile = initialFileName & String(201 - Len(initialFileName), Chr(0))
    openFile.lpstrTitle = "ファイルを開く"
    openFile.flags = OFN_HIDEREADONLY + OFN_FILEMUSTEXIST
    result = GetOpenFileName(openFile)
    If result <> 0 Then
        fileOpenDialog = Trim(Left(openFile.lpstrFile, InStr(1, openFile.lpstrFile, vbNullChar) - 1))
    End If
End Function

Public Function fileSaveDialog(ByVal hwnd As Long, ByVal initialDirectory As String, ByVal initialFileName As String, ByVal fileExtension As String) As String
    Dim openFile As OPENFILENAME
    Dim result As Long
    fileSaveDialog = ""
    openFile.lpstrFilter = fileExtension & "ファイル (*." & fileExtension & ")" & Chr(0) & "*." & fileExtension
    openFile.nFilterIndex = 1
    openFile.hwndOwner = hwnd
    openFile.lpstrFile = String(201, 0)
    #If VBA7 Then
        openFile.nMaxFile = LenB(openFile.lpstrFile) - 1
        openFile.lStructSize = LenB(openFile)
    #Else
        openFile.nMaxFile = Len(openFile.lpstrFile) - 1
        openFile.lStructSize = Len(openFile)
    #End If
    openFile.lpstrFileTitle = openFile.lpstrFile
    openFile.nMaxFileTitle = openFile.nMaxFile
    openFile.lpstrInitialDir = initialDirectory
    openFile.lpstrFile = initialFileName & String(201 - Len(initialFileName), Chr(0))
    openFile.lpstrDefExt = fileExtension
    openFile.lpstrTitle = "ファイルの保存"
    openFile.flags = 0
    result = GetSaveFileName(openFile)
    If result <> 0 Then
        fileSaveDialog = Trim(Left(openFile.lpstrFile, InStr(1, openFile.lpstrFile, vbNullChar) - 1))
    End If
End Function

Private Function createFilterString(ByVal fileFilters As Variant) As String
    Dim filterString As String
    filterString = ""
    For i = 0 To UBound(fileFilters)
        Dim filter() As String
        filter = Split(fileFilters(i), "|")
        If Len(filterString) > 0 Then
            filterString = filterString & Chr(0)
        End If
        If UBound(filter) = 1 Then
            filterString = filterString & filter(0) & Chr(0) & filter(1)
        ElseIf UBound(filter) = 0 Then
            filterString = filterString & filter(0)
        End If
    Next i
    createFilterString = filterString
End Function

2009年12月17日2017年2月21日

Accessでフォームが開かれているか確認

CurrentProject.AllForms("formName").IsLoaded

2009年12月2日2019年8月21日

VBAを書く前に認識しておきたいこと

まずは、開発環境を整える。
・オプションの「自動構文チェック」OFF
・オプションの「変数の宣言を強制する」ON
・オプションの「エラートラップ」をエラー発生時に中断に

VBA全般に関する注意事項
・連想配列はScripting.Dictionaryを使う
・Classは作れるが継承ができない
・ガベコレあるがバグがあるらしくNothingで開放した方がいい

AccessのVBAに関する注意事項
・「Form_formName」と「Forms!formName」は別物
　※DoCmdで操作できるのは!付きの方

2009年7月24日2017年2月21日

MS Accessでフォームが最小化されているか確認する

なぜか最小化状態のフォームは下記のサイズとなる

Forms("formName").WindowHeight = 420
Forms("formName").WindowWidth = 2400

2008年10月31日

VBからIEを操作する

何回も実行するとオートメーションエラーが出るようだ。何回も実行する要件のプログラム書く時は.net使うべきだと思う。

Dim ieObject As Object

Set ieObject = CreateObject("InternetExplorer.Application")

ieObject.Visible = True
ieObject.Navigate "http://www.google.co.jp/"

'READYSTATE_COMPLETE=4です
Do While ieObject.ReadyState <> 4 Or ieObject.Busy = True
    'nop
Loop

ieObject.Document.getElementsByName("q")(0).Value = "test"

ieObject.Quit

Set ieObject = Nothing

2008年10月31日2017年2月21日

VBでsleepを使う

APIを使用する

Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

2008年4月9日

VBでフォルダ内のファイル名一覧を取得

Dim path As String
path = "C:\test"

Dim fileName As String
fileName = Dir(path & "\*.*", vbNormal)

Do Until fileName = ""
    Debug.Print fileName
    fileName = Dir
Loop

2008年3月31日

MS AccessでADOトランザクション

Dim connection As New ADODB.connection
connection.ConnectionString = CurrentProject.BaseConnectionString
connection.Open

connection.BeginTrans

connection.Execute "UPDATE test SET val = 'test';"

connection.CommitTrans
'connection.RollbackTrans

2008年3月24日2017年2月21日

VBからADOでMDBにアクセスする

参照設定で「Microsoft ActiveX Data Objects X.X Library」を追加する
CurrentProject.BaseConnectionStringを常時使用すると様々なAccess本来の機能に不具合が出るので、排他ロックが必要な場合以外は大人しくCurrentProject.Connectionを使用するのが良いと思う。正直、AccessでADO使うの面倒くさい。

Dim connection As ADODB.connection
Dim recordset As ADODB.recordset

'ACCESS以外からの接続はこっちを使う
'Set connection = New ADODB.connection
'2000～2003
'connection.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\test.mdb"
'2007～
'connection.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\test.accdb"

'ACCESS内の接続はこっちを使う
Set connection = New ADODB.Connection
connection.ConnectionString = CurrentProject.BaseConnectionString
connection.Open

Set recordset = New ADODB.recordset

recordset.Open "SELECT * FROM test;", connection, adOpenKeyset, adLockPessimistic

Do While recordset.EOF = False
    Debug.Print recordset.Fields(0).Value
    Debug.Print recordset.Fields("column").Value
    recordset.MoveNext
Loop

recordset.Close
connection.Close

Set recordset = Nothing
Set connection = Nothing