テスト36

```vb

'Excel

Sub Ac_Inport2()

'----------------------------------------------------
'参照設定
'Microsoft ActiveX Data Objects x.x Library

'Excelにデータと貼付用のシートを準備しておく
'事前にAccessにテーブルを作っておく
'----------------------------------------------------
Dim ac As Variant                             'Accessアプリケーション
Dim cn As New ADODB.Connection    '接続オブジェクト
Dim rs As New ADODB.Recordset       'レコードセット
Dim cs As String                               '接続文
Dim Ac_FileName As String               'Accessファイルパス
Dim Ex_path As String              'Excelファイルパス
Dim flg As Integer

Application.ScreenUpdating = False

'ここで右外部結合にするか左外部結合にするか決める
flg = 2

'Accessファイル名
Ac_FileName = ThisWorkbook.Path & "\" & "テスト用テーブル.accdb"

'接続文
cs = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Ac_FileName & ";"

'Accessに接続
cn.Open cs
 
Dim Dlete_SQL1 As String
Dim Dlete_SQL2 As String

'削除用SQL
Dlete_SQL1 = "DELETE * FROM 今月テスト"
Dlete_SQL2 = "DELETE * FROM 先月テスト"

'一度テーブルのデータを全て削除する(テーブルの構造を残したまま削除する)
cn.Execute Dlete_SQL1
cn.Execute Dlete_SQL2

'Excelファイルのパス
Ex_path = "C:\Users\User\Desktop\VBA練習\VBA練習3.xlsm"

'Accessファイルオブジェクトを格納
Set ac = GetObject(Ac_FileName)

'Accessファイルを表示
ac.Visible = True

'VBA練習3.xlsmの[先月テスト]シートのデータをAccessの[先月テスト]テーブルにインポートする
ac.DoCmd.TransferSpreadsheet _
    acImport, , "先月テスト", Ex_path, True, "先月テスト!"
    
'VBA練習3.xlsmの[今月テスト]シートのデータをAccessの[今月テスト]テーブルにインポートする
ac.DoCmd.TransferSpreadsheet _
    acImport, , "今月テスト", Ex_path, True, "今月テスト!"
    

'AccessのAc_tes2tプロシージャを実行、戻り値(レコードセット)を取得
'書式：ac.Run(プロシージャ名, 引数)
If flg = 1 Then
    '右外部結合を実行して、得られたレコードを取得する
    Set rs = ac.Run("Ac_test2", 1)

ElseIf flg = 2 Then
     '左外部結合を実行して、得られたレコードを取得する
    Set rs = ac.Run("Ac_test2", 2)

End If

Dim i As Long       'カウント用
Dim j As Long      'カウント用
Dim sh As Variant '入力するシート
i = 2
j = 1

If flg = 1 Then
    'flg=1の時は[右外部結合]シートに入力
    Set sh = ThisWorkbook.Sheets("右外部結合")

ElseIf flg = 2 Then
    'flg=2の時は[左外部結合]シートに入力
    Set sh = ThisWorkbook.Sheets("左外部結合")

End If

With sh

    'フィルターが設定されていたら解除
    If .AutoFilterMode = True Then .Range("A1").AutoFilter
    
    '一旦全てのセルの内容を削除
    .Cells.ClearContents
    
    .Range("A1:C1").Value = Array("No", "先月分コード", "今月分コード")
    '先月分がNullで、それに対応する今月分のコードは開始(flg=1の時)
    '今月分がNullで、それに対応する先月分のコードは終了(flg=2の時)
    Do Until rs.EOF
    
        .Cells(i, 1).Value = j                                      'No
        .Cells(i, 2).Value = ac.Nz(rs.Fields(0), "Null") '商品カテゴリと商品(先月テスト分)
        .Cells(i, 3).Value = ac.Nz(rs.Fields(1), "Null") '商品カテゴリと商品(今月テスト分)

        rs.MoveNext
        i = i + 1
        j = j + 1
        
    Loop
 
End With

Application.ScreenUpdating = True

rs.Close
Set rs = Nothing

cn.Close
Set cn = Nothing

ac.Quit
Set ac = Nothing
  
End Sub


'------------------------------------------
'Access

Public Function Ac_test2(ByVal num As Integer) As Variant

'参照設定
'Microsoft ActiveX Data Objects x.x Library

Dim str_SQL As String           'SQL格納用
Dim rs As New ADODB.Recordset       'レコードセット

'numによって取得するSQL文を変更
If num = 1 Then
    'SQL文作成(右外部結合：今月テストテーブルを軸とする)
    str_SQL = "SELECT 先月テスト.商品カテゴリと商品, 今月テスト.商品カテゴリと商品 " & _
                    "FROM 先月テスト " & _
                    "RIGHT JOIN 今月テスト " & _
                    "ON 先月テスト.商品カテゴリと商品 = 今月テスト.商品カテゴリと商品 "
                
ElseIf num = 2 Then
    'SQL文作成(左外部結合：先月テストテーブルを軸とする)
    str_SQL = "SELECT 先月テスト.商品カテゴリと商品, 今月テスト.商品カテゴリと商品 " & _
                    "FROM 先月テスト " & _
                    "LEFT JOIN 今月テスト " & _
                    "ON 先月テスト.商品カテゴリと商品 = 今月テスト.商品カテゴリと商品 "

End If
                 
'SQLを実行(右外部結合 or 左外部結合)
rs.Open str_SQL, CurrentProject.Connection, adOpenStatic, adLockReadOnly, adCmdText

Set Ac_test2 = rs
Exit Function


End Function