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する前準備

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

ユーザー定義変数

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