Access 覚書

#レポートをPDFに保存
DoCmd.OutputTo acOutputReport, "XXXレポート名", acFormatPDF, "C:\Documents\デスクトップ\出力先.pdf"

#テーブルをExcelファイルに保存
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, テーブル名（クエリー名）, 出力ファイル名（フルパス）, True, ""

#テーブルから全レコード削除
DoCmd.RunSQL "DELETE * from テーブル名"

#ダイアログからファイル選択

'ファイル選択ダイアログ
Public Function SelectFile_FileDialog() As String

    'Microsoft Office XX Object Library 参照必要　msoFileDialogFilePicker
    
    Dim dlgfolder As FileDialog
    
    Application.FileDialog(msoFileDialogFilePicker).Title = "ファイルを選択"
    
    '自DBと同じフォルダ（AccessならCurrentProject.Path、ExcelならThisworkbook.Path）
    Application.FileDialog(msoFileDialogFilePicker).InitialFileName = CurrentProject.Path
    
    Application.FileDialog(msoFileDialogFilePicker).AllowMultiSelect = False
    
    If Application.FileDialog(msoFileDialogFilePicker).show = -1 Then
    
        'ファイルを選択
        SelectFile_FileDialog = Application.FileDialog(msoFileDialogFilePicker).SelectedItems(1)
        
    Else
    
        SelectFile_FileDialog = ""
        
    End If
    
End Function


#選択したファイル(CSV)からテーブル登録
Private Sub コマンド1_Click()

    Dim FileName As String

    'ファイル選択ダイアログ
    FileName = SelectFile_FileDialog
    
    '事前確認
    Ret = MsgBox("処理前に全レコードを削除します。", vbOKCancel + vbInformation, "ファイルインポート前処理確認")
    
    'OK以外なら終了
    If (Ret <> vbOK) Then Exit Sub
    
    DoCmd.RunSQL "DELETE * from TEST3"
    
    
    If FileName <> "" Then
    
        Dim rs As New ADODB.Recordset
    
        'テーブル
        rs.Open "TEST3", CurrentProject.Connection, , adLockOptimistic

        With CreateObject("ADODB.Stream")
        
            .LineSeparator = 10 ' adLF = 10, adCR = 13, adCRLF = -1(default)
            .Charset = "UTF-8"
            .Open
            .LoadFromFile FileName

            '最初の行を捨てる
            tmp = .ReadText(-2)
            i = 0

            Do Until .EOS

                '#ReadTextの引数-1で全て、-2で一行ずつ
                buf = .ReadText(-2)
                i = i + 1
                
                tmp = Split(buf, ",")
                
                rs.AddNew
                
                rs!Id = i
                rs!氏名 = tmp(0)
                
                rs.Update
                
            Loop
            
            .Close

        End With
        
        rs.Close
        
    Else
    
        MsgBox "ファイルが指定できていません", vbExclamation + vbOKOnly, "ファイル未選択"
        
    End If

End Sub


#選択したファイルからユーザー定義変数を経由してAddNewする前準備
```VBA
Private Sub コマンド3_Click()

'ExcelをOpenして値取得

    Dim oApp    As Object
    Dim oBook   As Object
    Dim oSheet  As Object
    
    Dim certA() As CertReq '別途 Typeで構造体宣言
    
    Dim FileName As String


    'ファイル選択ダイアログ
    FileName = SelectFile_FileDialog
    
    'EXCELファイルOpen
    Set oApp = CreateObject("Excel.Application")
    
    oApp.Visible = False '（可視化不可）
        
    On Error Resume Next
    
     '指定EXCELファイルOpen
    Set oBook = oApp.Workbooks.Open(FileName)
    Set oSheet = oBook.Worksheets("test")


    '行始まり、列始まり調整
    sRow = 4
    sCol = 1
    
    For i = 1 To 20 Step 1
    
        If (oSheet.Cells(i + sRow, 1 + sCol).Value = "") Then Exit For
        
        ReDim Preserve certA(i)
        certA(i).UserID = i
        certA(i).LastName = oSheet.Cells(i + sRow, 1 + sCol).Value
        certA(i).FirstName = oSheet.Cells(i + sRow, 2 + sCol).Value
        certA(i).sDate = oSheet.Cells(i + sRow, 3 + sCol).Value
            
    Next i
              
    'EXCELの終了
    oBook.Close False
    Set oBook = Nothing
    
    oApp.DisplayAlerts = True
    oApp.Quit

    Set oApp = Nothing
    
    
    For x = 1 To i Step 1
    
        MsgBox certA(x).UserID & certA(x).LastName & certA(x).FirstName & certA(x).sDate
    
    Next x
      
    MsgBox "End"
    
End Sub
```

ユーザー定義変数

```VBA
Private Type CertReq
    
    UserID As Integer
    LastName As String
    FirstName As String
    sDate As String
    
End Type
```