| |
ADO接続で読み込み
Sub ボタン1_Click()
Dim wsDest As Worksheet
Dim lastRow As Long
Dim filePath As String
' ファイルダイアログを使用してファイルを選択
With Application.FileDialog(msoFileDialogOpen)
.Title = "Select the Excel file"
.Filters.Add "Excel Files", "*.xlsx; *.xlsm; *.xls"
.AllowMultiSelect = False
If .Show = -1 Then
filePath = .SelectedItems(1)
Else
MsgBox "ファイルが選択されていません。"
Exit Sub
End If
End With
' 勘定科目シートの存在を確認
On Error Resume Next
Set wsDest = ThisWorkbook.Sheets("勘定科目")
On Error GoTo 0
If wsDest Is Nothing Then
MsgBox "シート '勘定科目' が見つかりません。シート名を確認してください。"
Exit Sub
End If
'勘定科目シートのA:Z列の最終行を取得
With Intersect(wsDest.UsedRange, wsDest.Columns("a:z"))
lastRow = wsDest.Evaluate("max(if(" & .Address & "<>"""",row(" & .Address & ")))")
End With
' 外部ファイルのシート名を取得する
Dim wsName$
With CreateObject("DAO.DBEngine.120").workspaces(0).OpenDatabase(filePath, True, True, "excel 12.0;HDR=No;")
wsName = Replace(.tabledefs(0).Name, "'", "")
wsName = Left$(wsName, Len(wsName) - 1)
.Close
End With
' 外部ファイルをDatabaseとして接続する
Dim s$
s = "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & filePath & _
";Extended Properties='Excel 12.0;HDR=No';"
With CreateObject("ADODB.Recordset")
.Open "Select * From `" & wsName & "$A3:Z`", s
wsDest.Cells(lastRow + 1, 1).CopyFromRecordset .DataSource
End With
MsgBox "データのコピーが完了しました。"
End Sub
|
|
jindon
- 24/9/29(日) 12:52 -
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
