MS Excel - Подключение листа книги (tdf.Connect)
...
Есть книга Excel "C:\Data\Новые сотрудники.xls". В этой книге есть лист "output", с таблицей данных (первая строка - название полей).
SELECT * INTO Temp FROM [output$] IN 'C:\Data\Новые сотрудники.xls'[excel 8.0; hdr=yes;]
Или:
SELECT *
FROM (SELECT * FROM [sheet1$A:D] AS xlData IN 'C:\path to file\myExcelFileName.xlsx'[Excel 12.0;HDR=yes;IMEX=1;ACCDB=Yes]) AS XL
Если название листа состоит из нескольких слов, то данная конструкция может не работать на старых версиях офиса, спасает обрамление названия листа в одинарные кавычки, вот так:
"’Лист один’"
Public Function LinkExcelList(sExcelFilePath As String, sListName As String, sLocTableName As String) As Long
Dim strLink As String
Dim tdf As TableDef
On Error GoTo LinkExcelListErr
strLink = "Excel 12.0;DATABASE=" & sExcelFilePath
Set tdf = CurrentDb.CreateTableDef(sLocTableName)
tdf.Connect = strLink
tdf.SourceTableName = sListName & "$"
If DCount("*", "MSysObjects", "[Name]='" & sLocTableName & "' AND Type=6") > 0 Then
CurrentDb.TableDefs.Delete sLocTableName
End If
CurrentDb.TableDefs.Append tdf
Application.RefreshDatabaseWindow
LinkExcelListEnd:
Set tdf = Nothing
Exit Function
LinkExcelListErr:
LinkExcelList = Err.Number
MsgBox "Функция [LinkExcelList] привела к ошибке:" & vbCrLf & _
Err.Description & vbCrLf & " Err#" & Err.Number, vbCritical
Resume LinkExcelListEnd
End Function
Пример эксплуатации:
Private Sub Demo_LinkExcelList()
Dim lVal As Long, sPath$, sVal$
sPath = "d:\Temp\Del\Asnya911 Файл для тестов 050.xlsx"
lVal = LinkExcelList(sPath, "Продажи", "LinkedExcelList")
If lVal > 0 Then
Exit Sub
End If
End Sub
Запросом:
Private Sub Test02()
Dim qdf As QueryDef
Dim StrSql As String
Dim sQueryName As String
Dim bQueryPresent As Boolean
Dim s$
s = "d:\Temp\Пример\Пример.xlsx"
If s = "" Then Exit Sub
If Dir(s, vbNormal) = "" Then Exit Sub
sQueryName = "qExcelList" 'Имя запроса
'Тело запроса
StrSql = "SELECT * FROM [Лист1$] IN '" & s & "' [excel 12.0; hdr=yes]"
' Пытаемся узнать есть ли запрос с таким названием:
For Each qdf In CurrentDb.QueryDefs
'если запрос есть
If qdf.Name = sQueryName Then
bQueryPresent = True 'Запрос уже есть
End If
Next qdf
If bQueryPresent = False Then
' создаем QueryDef
Set qdf = CurrentDb.CreateQueryDef(sQueryName)
Else
'Если запрос уже открыт
If CurrentData.AllQueries(sQueryName).IsLoaded Then
DoCmd.Close acQuery, "sQueryName"
End If
Set qdf = CurrentDb.QueryDefs(sQueryName)
End If
qdf.sql = StrSql 'Задаём "тело" запроса
' открываем
DoCmd.OpenQuery sQueryName, acViewNormal
Set qdf = Nothing
End Sub
(Подключение в режиме: READONLY - редакция данных не доступна.)
|