Обзор, импорт и добавление вкладок excel для Access 2007

Question

У меня есть база данных Access 2007 с именем BusRoutes с двумя таблицами в ней, называемыми Routes and Stops. У меня также есть несколько таблиц Excel, основанных на шаблоне excel, которые заполняются драйверами. Эти таблицы всегда должны иметь одинаковый формат, но не одинаковые имена файлов. Я пытаюсь создать кнопку, которая будет выполнять следующие действия:

Позволяет пользователю перейти к таблице Excel, выбрать вкладку «Маршруты шины» и добавить все данные в таблицу доступа «Маршруты».

Перейдите к одной и той же электронной таблице Excel и выберите вкладку «Остановить шину» и добавьте все данные в таблицу «Останавливает».

Таблицы Excel могут храниться в любом месте. Я не могу контролировать, где на компьютере водителя он хранит электронные таблицы Excel.

Имена таблиц будут отличаться, поскольку их соглашения об именах «основаны на номере маршрута и учебном году, в котором они приводятся.

Имена заголовков таблиц Excel в точности соответствуют именам полей соответствующих таблиц, которые они импортируют. Названия таблиц и информация заголовка не изменяются в электронной таблице.

Таблицами могут быть версии 2003 или 2007 года.

О, и «e-mail_add» - это гиперссылка, которая имеет значение.

Я знаю, что мне нужно использовать действие TransferSpreadsheets для добавления данных, но я не понимаю, как перейти к электронной таблице, выбрать отдельные вкладки и передать эту переменную в действие TransferSpreadsheets.

Я пробовал это как попытку хотя бы попытаться вернуть значение имени файла, но вышла из строя со второй строки со следующей ошибкой: Ошибка времени выполнения -2147467259 (80004005) ': Метод' FileDialog 'объекта aobject'_Application' не смогли.

Set dlg = Application.FileDialog(msoFileDialogFilePicker) 

dlg.Title = "Select Excel Spreadsheet to import" 
dlg.AllowMultiSelect = False 
dataPath = dlg.SelectedItems(1) 
Me!browseDataPath = dataPath 
MsgBox("File is " & dataPath, vbOKOnly, "Check file name") 

End If 

Помогите кому-нибудь?

Answer 1

Было бы довольно просто использовать простую форму, как это:

с кодом позади него, что есть что-то вдоль этих линий

Option Compare Database 
Option Explicit 

Private Sub cmdBrowse_Click() 
    Dim dlg As Object ' FileDialog 
    Dim sheetList As String, i As Long 
    Dim xlApp As Object ' Excel.Application 
    Dim xlWorkBook As Object ' Excel.Workbook 

    Set dlg = Application.FileDialog(3) ' msoFileDialogFilePicker 
    dlg.Title = "Select Excel Document to import" 
    dlg.Filters.Clear 
    dlg.Filters.Add "Excel documents", "*.xls*", 1 
    dlg.AllowMultiSelect = False 
    dlg.Show 
    If dlg.SelectedItems.Count > 0 Then 
     Me.browseDataPath.Value = dlg.SelectedItems.Item(1) 
     Set xlApp = CreateObject("Excel.Application") 
     Set xlWorkBook = xlApp.Workbooks.Open(Me.browseDataPath.Value) 
     sheetList = "" 
     For i = 1 To xlWorkBook.Sheets.Count 
      sheetList = sheetList & ";" & xlWorkBook.Sheets(i).Name 
     Next 
     Me.lstSheets.RowSourceType = "Value List" 
     Me.lstSheets.RowSource = Mid(sheetList, 2) 
     xlWorkBook.Close 
     Set xlWorkBook = Nothing 
     xlApp.Quit 
     Set xlApp = Nothing 
    End If 
    Set dlg = Nothing 
End Sub 

Все, что вам нужно сделать сейчас добавьте кнопку «ОК», чтобы использовать значения текстового поля и выбора списка для вызова DoCmd.TransferSpreadsheet.

Answer 2

**'This code goes behind the button which imports the file** 

    Option Compare Database 

    Private Sub Command2_Click() 

    Dim s_Filter As String 
     Dim s_InputFileName As String 

     s_Filter = ahtAddFilterItem(s_Filter, "Excel Files (*.XLSX)", "*.XLSX") 
     s_InputFileName = ahtCommonFileOpenSave(_ 
           Filter:=s_Filter, OpenFile:=True, _ 
           DialogTitle:="Please select an input file...", _ 
           Flags:=ahtOFN_HIDEREADONLY) 

     Me.Text0.Value = s_InputFileName 

    '------------code for importing---------------------------------------------------------------------- 

    'Excel variables 
    Dim xlApp As Excel.Application 
    Dim xlFile As Excel.Workbook 
    Dim xlSheet As Excel.Worksheet 
    Dim xlRange As Excel.Range 
    Dim xlRange1 As Excel.Range 

    'Get the info from Excel: 
    Set xlApp = CreateObject("Excel.Application") 

    Set xlFile = xlApp.Workbooks.Open(s_InputFileName) 
    filepath = RTrim(LTrim(Me.Text0.Value)) 

    With xlApp 
    .Visible = True 
    With .Workbooks(.Workbooks.Count) 
    For i = 1 To .Worksheets.Count 
    WrksheetName = .Worksheets(i).Name 

    Set xlSheet = xlFile.Sheets(WrksheetName) 
    Set xlRange = xlSheet.Range("AA5") 
    Set xlRange1 = xlSheet.Range("A65536") 

    lcolumn = xlRange.End(xltoleft).Address 
    lrow = xlRange1.End(xlUp).Row 

    lcol = Mid(lcolumn, 2, 1) 


    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, WrksheetName, filepath, True, WrksheetName & "!A5:" & lcol & lrow 

    Next i 
    'Next i 
    End With 
    End With 
    Set xlApp = Nothing 
    Set xlFile = Nothing 
    Set xlSheet = Nothing 
    Set xlRange = Nothing 
    Set xlRange1 = Nothing 

    End Sub 

****'Then paste this code to a module**** 

'--------Code to be written in module to support browse code------------------------ 

Option Compare Database 

'***************** Code Start ************** 
'This code was originally written by Ken Getz. 
'It is not to be altered or distributed, 
'except as part of an application. 
'You are free to use it in any application, 
'provided the copyright notice is left unchanged. 
' 
' Code courtesy of: 
' Microsoft Access 95 How-To 
' Ken Getz and Paul Litwin 
' Waite Group Press, 1996 

Type tagOPENFILENAME 
    lStructSize As Long 
    hwndOwner As Long 
    hInstance As Long 
    strFilter As String 
    strCustomFilter As String 
    nMaxCustFilter As Long 
    nFilterIndex As Long 
    strFile As String 
    nMaxFile As Long 
    strFileTitle As String 
    nMaxFileTitle As Long 
    strInitialDir As String 
    strTitle As String 
    Flags As Long 
    nFileOffset As Integer 
    nFileExtension As Integer 
    strDefExt As String 
    lCustData As Long 
    lpfnHook As Long 
    lpTemplateName As String 
End Type 

Declare Function aht_apiGetOpenFileName Lib "comdlg32.dll" _ 
    Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean 

Declare Function aht_apiGetSaveFileName Lib "comdlg32.dll" _ 
    Alias "GetSaveFileNameA" (OFN As tagOPENFILENAME) As Boolean 
Declare Function CommDlgExtendedError Lib "comdlg32.dll"() As Long 

Global Const ahtOFN_READONLY = &H1 
Global Const ahtOFN_OVERWRITEPROMPT = &H2 
Global Const ahtOFN_HIDEREADONLY = &H4 
Global Const ahtOFN_NOCHANGEDIR = &H8 
Global Const ahtOFN_SHOWHELP = &H10 
' You won't use these. 
'Global Const ahtOFN_ENABLEHOOK = &H20 
'Global Const ahtOFN_ENABLETEMPLATE = &H40 
'Global Const ahtOFN_ENABLETEMPLATEHANDLE = &H80 
Global Const ahtOFN_NOVALIDATE = &H100 
Global Const ahtOFN_ALLOWMULTISELECT = &H200 
Global Const ahtOFN_EXTENSIONDIFFERENT = &H400 
Global Const ahtOFN_PATHMUSTEXIST = &H800 
Global Const ahtOFN_FILEMUSTEXIST = &H1000 
Global Const ahtOFN_CREATEPROMPT = &H2000 
Global Const ahtOFN_SHAREAWARE = &H4000 
Global Const ahtOFN_NOREADONLYRETURN = &H8000 
Global Const ahtOFN_NOTESTFILECREATE = &H10000 
Global Const ahtOFN_NONETWORKBUTTON = &H20000 
Global Const ahtOFN_NOLONGNAMES = &H40000 
' New for Windows 95 
Global Const ahtOFN_EXPLORER = &H80000 
Global Const ahtOFN_NODEREFERENCELINKS = &H100000 
Global Const ahtOFN_LONGNAMES = &H200000 


Function ahtAddFilterItem(strFilter As String, _ 
    strDescription As String, Optional varItem As Variant) As String 
' Tack a new chunk onto the file filter. 
' That is, take the old value, stick onto it the description, 
' (like "Databases"), a null character, the skeleton 
' (like "*.mdb;*.mda") and a final null character. 

    If IsMissing(varItem) Then varItem = "*.*" 
    ahtAddFilterItem = strFilter & _ 
       strDescription & vbNullChar & _ 
       varItem & vbNullChar 
End Function 

Function ahtCommonFileOpenSave(_ 
      Optional ByRef Flags As Variant, _ 
      Optional ByVal InitialDir As Variant, _ 
      Optional ByVal Filter As Variant, _ 
      Optional ByVal FilterIndex As Variant, _ 
      Optional ByVal DefaultExt As Variant, _ 
      Optional ByVal filename As Variant, _ 
      Optional ByVal DialogTitle As Variant, _ 
      Optional ByVal hWnd As Variant, _ 
      Optional ByVal OpenFile As Variant) As Variant 
' This is the entry point you'll use to call the common 
' file open/save dialog. The parameters are listed 
' below, and all are optional. 
' 
' In: 
' Flags: one or more of the ahtOFN_* constants, OR'd together. 
' InitialDir: the directory in which to first look 
' Filter: a set of file filters, set up by calling 
' AddFilterItem. See examples. 
' FilterIndex: 1-based integer indicating which filter 
' set to use, by default (1 if unspecified) 
' DefaultExt: Extension to use if the user doesn't enter one. 
' Only useful on file saves. 
' FileName: Default value for the file name text box. 
' DialogTitle: Title for the dialog. 
' hWnd: parent window handle 
' OpenFile: Boolean(True=Open File/False=Save As) 
' Out: 
' Return Value: Either Null or the selected filename 
Dim OFN As tagOPENFILENAME 
Dim strFileName As String 
Dim strFileTitle As String 
Dim fResult As Boolean 
    ' Give the dialog a caption title. 
    If IsMissing(InitialDir) Then InitialDir = CurDir 
    If IsMissing(Filter) Then Filter = "" 
    If IsMissing(FilterIndex) Then FilterIndex = 1 
    If IsMissing(Flags) Then Flags = 0& 
    If IsMissing(DefaultExt) Then DefaultExt = "" 
    If IsMissing(filename) Then filename = "" 
    If IsMissing(DialogTitle) Then DialogTitle = "" 
    If IsMissing(hWnd) Then hWnd = Application.hWndAccessApp 
    If IsMissing(OpenFile) Then OpenFile = True 
    ' Allocate string space for the returned strings. 
    strFileName = Left(filename & String(256, 0), 256) 
    strFileTitle = String(256, 0) 
    ' Set up the data structure before you call the function 
    With OFN 
     .lStructSize = Len(OFN) 
     .hwndOwner = hWnd 
     .strFilter = Filter 
     .nFilterIndex = FilterIndex 
     .strFile = strFileName 
     .nMaxFile = Len(strFileName) 
     .strFileTitle = strFileTitle 
     .nMaxFileTitle = Len(strFileTitle) 
     .strTitle = DialogTitle 
     .Flags = Flags 
     .strDefExt = DefaultExt 
     .strInitialDir = InitialDir 
     ' Didn't think most people would want to deal with 
     ' these options. 
     .hInstance = 0 
     '.strCustomFilter = "" 
     '.nMaxCustFilter = 0 
     .lpfnHook = 0 
     'New for NT 4.0 
     .strCustomFilter = String(255, 0) 
     .nMaxCustFilter = 255 
    End With 
    ' This will pass the desired data structure to the 
    ' Windows API, which will in turn it uses to display 
    ' the Open/Save As Dialog. 
    If OpenFile Then 
     fResult = aht_apiGetOpenFileName(OFN) 
    Else 
     fResult = aht_apiGetSaveFileName(OFN) 
    End If 

    ' The function call filled in the strFileTitle member 
    ' of the structure. You'll have to write special code 
    ' to retrieve that if you're interested. 
    If fResult Then 
     ' You might care to check the Flags member of the 
     ' structure to get information about the chosen file. 
     ' In this example, if you bothered to pass in a 
     ' value for Flags, we'll fill it in with the outgoing 
     ' Flags value. 
     If Not IsMissing(Flags) Then Flags = OFN.Flags 
     ahtCommonFileOpenSave = TrimNull(OFN.strFile) 
    Else 
     ahtCommonFileOpenSave = vbNullString 
    End If 
End Function 

Private Function TrimNull(ByVal strItem As String) As String 
Dim intPos As Integer 
    intPos = InStr(strItem, vbNullChar) 
    If intPos > 0 Then 
     TrimNull = Left(strItem, intPos - 1) 
    Else 
     TrimNull = strItem 
    End If 
End Function