Access VBA ノート(サンプルコード)

Hide Tamura の Access VBA ノート

Access-VBA DoCmd.TransferText テーブル/クエリをCSVファイルにエクスポート

progani

次の例では、使っているクエリの名前は、qryAprint個人顧客 です。

Private Sub cmdエクスポート_Click()
On Error GoTo cmdエクスポート_Click_Err

    'カレントデータベースと同じフォルダに書き出し
    DoCmd.TransferText acExportDelim, "", "qryAprint個人顧客", CurrentProject.Path & "\qryAprint個人顧客.csv", False, ""
    Beep
    MsgBox "エクスポートを終了しました", vbInformation, "エクスポート"


cmdエクスポート_Click_Exit:
    Exit Sub

cmdエクスポート_Click_Err:
    MsgBox Error$
    Resume cmdエクスポート_Click_Exit

End Sub

カレントデータベースと同じフォルダに書き出ししたい場合は、CurrentProject.Path を指定しないと、
「ツール」-「オプション」-「全般」の『既定のデータベースフォルダ』に書き出される

構文
式。 TransferText (TransferType, SpecificationName, TableName, FileName, HasFieldNames, HTMLTableName, CodePage)

第3引数 TableName テキスト データのインポート、エクスポート、リンクを行う Microsoft Access テーブルの名前、または結果をテキスト ファイルにエクスポートする Microsoft Access クエリの名前を、文字列式で指定します。

第5引数 HasFieldNames  は、テキスト ファイルの 1 行目をフィールド名として使用する場合は、True (–1) を使います。テキスト ファイルの 1 行目をデータとして処理する場合は、False (0) を使います。この引数を指定しないと、False (既定値) が使われます。 



次の例では、一つのフォームで、法人用データ、個人用データ、その他データのクエリを入れ替えて利用しています。
フォームを開くときに、DoCmd.OpenForm のOpenArgsプロパティを利用して、法人・個人・その他 の、どのデータを開いているかを記憶しています。
CSVで書き出す時には、Select Case ステートメントでOpenArgsプロパティを確認して、法人・個人・その他 を分岐させています。

'-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
'   フォームを開く
'-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-

Private Sub cmdAprint_Click()
On Error GoTo Err_cmdAprint_Click

    Dim stDocName As String
    Dim strRecordSource As String

    stDocName = "frmAprint"
    strRecordSource = "qryAprint個人顧客"
    
    DoCmd.OpenForm stDocName, , , , , , "個人"
    Forms(stDocName).RecordSource = strRecordSource
    Forms(stDocName).lblTitle.Caption = "個人顧客"

Exit_cmdAprint_Click:
    Exit Sub

Err_cmdAprint_Click:
    MsgBox Err.Description
    Resume Exit_cmdAprint_Click
    
End Sub


'-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
'   CSVファイルにエクスポートします
'-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-

Private Sub cmdエクスポート_Click()
On Error GoTo cmdエクスポート_Click_Err

    Dim strCSV As String
    Dim strQuery As String
    
    strTitle = Me.lblTitle.Caption
    
    strCSV = CurrentProject.Path & "\" & strTitle & ".csv"

    Select Case Me.OpenArgs
    
        Case "個人"
            strQuery = "qryAprint個人顧客"
    
        Case "法人"
            strQuery = "qryAprint法人顧客"
        
        Case "その他"
            strQuery = "qryAprint顧客外年賀状データ"
    
    End Select

    'カレントデータベースと同じフォルダに書き出し
    DoCmd.TransferText acExportDelim, "", strQuery, strCSV, False, ""
    Beep
    MsgBox "エクスポートを終了しました", vbInformation, "エクスポート"


cmdエクスポート_Click_Exit:
    Exit Sub

cmdエクスポート_Click_Err:
    MsgBox Error$
    Resume cmdエクスポート_Click_Exit

End Sub



次の例は、AccessにCSVを書き出す為のプログラム「CSV書き出し」を書き、それをExcel側のプログラムで実行しています。

Accessファイル名「MY体重管理.accdb」の
テーブル名「tblデータ」のデータを
CSVファイル名「体重管理.csv」で書き出します。

Access側
Const strFileName As String = "体重管理"

Sub CSV書き出し()
    DoCmd.TransferText TransferType:=acExportDelim, TableName:="tblデータ", _
        FileName:=Application.CurrentProject.Path & "\" & strFileName & ".csv"
End Sub


Excel側
Const DB_Name As String = "\MY体重管理.accdb"

Sub CSV()
    Dim strPath As String
    Dim objACS As Object
    
    strPath = ThisWorkbook.Path & DB_Name
    
    Set objACS = CreateObject("Access.Application")
    
    With objACS
        .Visible = False  'アプリケーションを非表示
        .OpenCurrentDatabase (strPath)
        .Run ("CSV書き出し") 'Accessに書いたサブルーチン
        .CloseCurrentDatabase
        .Quit
    End With
    
    Set objACS = Nothing
    
    MsgBox "CSVファイルの書き出しが完了しました", vbInformation
    
End Sub


こちらも参考に Excel VBAノート




Access-VBA アクティブフォーム名 Screen.ActiveForm.Name

Sub FormsSample()
        
    '現在のアクティブフォーム名
    MsgBox Screen.ActiveForm.Name
    
End Sub

Screen.ActiveReport 現在アクティブなレポート
Screen.ActiveControl 現在アクティブなコントロール


 ↓ facebook のフォローで応援してください。お願いします。



Microsoft Office ブログランキングへ


 

Access-VBA フォームがロードされているかチェック!IsLoaded

Sub FormsSample()
    
    'フォームがロードされいるかのチェック
    If CurrentProject.AllForms!frmデータ入力.IsLoaded Then
        MsgBox "ロードされています"
    End If
        
End Sub

 ↓ facebook のフォローで応援してください。お願いします。



Microsoft Office ブログランキングへ



Access-VBA 開いているフォームを参照。全てのフォームを参照 Forms, CurrentProject.AllForms

Sub FormsSample()
    Dim myObject As AccessObject
    Dim myForm As Form
    Dim myStr As String
    Dim i As Long
    
    myStr = ""
    
    '開いているフォームを参照
    For Each myForm In Forms
    
        myStr = myStr & myForm.Name & vbCr
        
    Next
    
    MsgBox myStr
    
    myStr = ""
    
    '開いているフォームを参照
    For i = Forms.Count - 1 To 0 Step -1
    
        myStr = myStr & Forms(i).Name & vbCr
    
    Next i
    
    MsgBox myStr
    
    Forms!frmデータ表示.SetFocus
    
    '開いていないフォームも全て参照
    For Each myObject In CurrentProject.AllForms
    
        myStr = myStr & myObject.Name & vbCr
        
    Next
    
    MsgBox myStr
    
End Sub


 ↓ facebook のフォローで応援してください。お願いします。



Microsoft Office ブログランキングへ


Access-VBA [SQL] テーブル定義 ALTER TABLE (ADD DROP ALTER)

Sub ALTER_TABLE_ADD()
    Dim StrSQL As String
    StrSQL = "ALTER TABLE 商品テーブル ADD COLUMN 料金 MONEY;"
    CurrentDb.QueryDefs("Qクエリ").SQL = StrSQL
    DoCmd.SetWarnings False
    DoCmd.OpenQuery "Qクエリ"
    DoCmd.SetWarnings True
End Sub

Sub ALTER_TABLE_DROP()
    Dim StrSQL As String
    StrSQL = "ALTER TABLE 商品テーブル DROP COLUMN 料金;"
    CurrentDb.QueryDefs("Qクエリ").SQL = StrSQL
    DoCmd.SetWarnings False
    DoCmd.OpenQuery "Qクエリ"
    DoCmd.SetWarnings True
End Sub

Sub ALTER_TABLE_ALTER()
    Dim StrSQL As String
    StrSQL = "ALTER TABLE 商品テーブル ALTER COLUMN 料金 TEXT(6);"
    CurrentDb.QueryDefs("Qクエリ").SQL = StrSQL
    DoCmd.SetWarnings False
    DoCmd.OpenQuery "Qクエリ"
    DoCmd.SetWarnings True
End Sub

Sub ALTER_TABLE_DROP_RUN()
    Dim StrSQL As String
    StrSQL = "ALTER TABLE 商品テーブル DROP COLUMN 料金;"
    DoCmd.SetWarnings False
    DoCmd.RunSQL StrSQL
    DoCmd.SetWarnings True
End Sub

SQL データ型
http://office.microsoft.com/ja-jp/access-help/HP001032248.aspx?redir=0

TEXT(4), INTEGER, SMALLINT, FLOAT, MONEY ・・・


 ↓ facebook のフォローで応援してください。お願いします。



Microsoft Office ブログランキングへ




Access-VBA [FileSystemObject] テキストファイル書込み / 読込み TextStream

Sub TextStream_Write()
    Dim FSO As New FileSystemObject
    Dim MyTS As TextStream
    Dim MyPath As String
    
    MyPath = CurrentProject.Path & "\Sample2\sample.txt"
    
    Set MyTS = FSO.OpenTextFile(MyPath, ForWriting)  'ForAppending は追記
    
    MyTS.Write "田村桃太郎"
    MyTS.WriteBlankLines 1
    MyTS.WriteLine "田村小太郎"
    
    MyTS.Close
    
    Set MyTS = Nothing
    
End Sub

Sub TextStream_Read()
    Dim FSO As New FileSystemObject
    Dim MyTS As TextStream
    Dim MyPath As String
    
    MyPath = CurrentProject.Path & "\Sample2\Sample.txt"
    
    Set MyTS = FSO.OpenTextFile(MyPath, ForReading)
    
    '2文字読み込み
    MsgBox MyTS.Read(2)
    
    '2文字読み込み
    MsgBox MyTS.Read(2)
    
    '改行まで読み込み
    MsgBox MyTS.ReadLine
    
    '全て読み込み
    MsgBox MyTS.ReadAll
    
    MyTS.Close
    
    Set MyTS = Nothing
    
End Sub


 ↓ facebook のフォローで応援してください。お願いします。



Microsoft Office ブログランキングへ



Access-VBA [Shell.Application] フォルダ参照ダイアログボックス BrowseForFolder

Sub ShellTest()
    Dim MySHL As Object
    Dim MySHL2 As Object
    Dim StrPath As String
    
    Set MySHL = CreateObject("Shell.Application")
    Set MySHL2 = MySHL.BrowseForFolder(0, "リストからフォルダを選択してください", 0, CurrentProject.Path)
    
    If Not MySHL2 Is Nothing Then
        StrPath = MySHL2.Items.Item.Path
        MsgBox StrPath
    End If

    Set MySHL = Nothing
    Set MySHL2 = Nothing

End Sub


MySHL2 = MySHL.BrowseForFolder( Hwnd , sTitle , iOptions [, vRootFolder ])

Hwnd 0でいい
sTitle ダイアログ内に表示される文字列
iOptions 0でいい
vRootFolder ルートフォルダ。省略すると「デスクトップ」がルートフォルダ


 ↓ facebook のフォローで応援してください。お願いします。



Microsoft Office ブログランキングへ



Access-VBA [FileDialog] ファイル参照ダイアログボックス FileDialog(msoFileDialogFilePicker)

Sub FilePicker()
    Dim MyFD As FileDialog
    Set MyFD = Application.FileDialog(msoFileDialogFilePicker)
    
    With MyFD
    
        .InitialFileName = CurrentProject.Path
        
        .Filters.Clear
        .Filters.Add "テキスト", "*.txt", 1
        .Filters.Add "CSVファイル", "*.csv", 2
        .Filters.Add "全てのファイル", "*.*", 3
        .FilterIndex = 2
        
        If .Show Then
            MsgBox .SelectedItems(1)
        End If
    
    End With
    
    Set MyFD = Nothing
    
End Sub


 ↓ facebook のフォローで応援してください。お願いします。



Microsoft Office ブログランキングへ



 

Access-VBA DeleteObject オブジェクトの削除(テーブルの削除)

Sub DeleteObj()
    DoCmd.DeleteObject acTable, "Copy健康管理"
End Sub

expression.DeleteObject(ObjectType, ObjectName)


 ↓ facebook のフォローで応援してください。お願いします。



Microsoft Office ブログランキングへ





 

Access-VBA DoCmd.CopyObject オブジェクトのコピー(テーブルのコピー)

Sub CopyObj()
    DoCmd.CopyObject , "Copy健康管理", acTable, "tbl健康管理"
End Sub

expression.CopyObject(DestinationDatabase, NewName, SourceObjectType, SourceObjectName)


 ↓ facebook のフォローで応援してください。お願いします。



Microsoft Office ブログランキングへ



 
Access VBA ノートについて(注意事項)
このAccess VBA ノートは、プログラムを再利用したり、コピペで入力の手間を省く為に作ったネット上のノートです。
詳しい解説は書いておりません。エラー等のトラブルには責任は負いません。利用者の環境に合わせて書き換えてご利用ください。

記事をうまくカテゴリー分け出来ていない場合があります。↓下の記事検索で、キーワード検索してください。
記事検索
ExcelVBAマクロ作成代行


様々な企業、会計事務所、病院からマクロ作成代行を請け負っております。マクロ作成でお役に立てたら嬉しいです。まずはお気軽にご相談ください。
最新記事
Access VBA & マクロ 書籍
Access VBA 担当 Hide Tamura
■VBA Expert
VBA Expert Standard Crown
ExcelVBA Standard
Access VBA Standard
Excel2002 VBA Standard
■MICROSOFT OFFICE USER SPECIALIST
Microsoft Excel version2002 Expert
Microsoft Excel version2002
Excel VBAノート
Hide Tamura の個人的なVBAノートです。

頻繁に使うVBAコードなどを記録しコピペして使う為に作りました。お役に立てるようでしたら、お使いください。

Excel 関数 ノート
Excel関数を中心に、Excelの便利機能や、意外としらない使い方など書いていきます。

Excel関数ノート
Excelで作る経営計画
Excelで利益計画を立てましょう!会社にいくらの利益が必要で、その為の売上高は?

Excelで作る経営計画
アクセスカウンター