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

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

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

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

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

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

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

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

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