Vytvoøení databáze MS Access z aplikace Excel pomocí objektu DAO

V nìkterých pøípadech mùžete chtít vytvoøit databázi aplikace Microsoft Access z Aplikace Microsoft Excel pro Windows 95 verze 7.0 sešitu, ale nejsou schopny použijte odkazy. Zatímco upøednostòovaný zpùsob pøesunutí aplikace Microsoft Excel sešit do aplikace Microsoft Access je použít odkazy, mùžete použít také pøístup k datùm (DAO) objektu.

Zahrnout dùvodù není možné použít odkazy (ale nejsou pouze) následující:

• Není nainstalována aplikace Microsoft Access pro Windows 95 verze 7.0 na poèítaè.
• Nejsou dostatek systémových prostøedkù v aplikaci Microsoft Excel a Aplikace Microsoft Access naèíst souèasnì.

Mùžete vytvoøit libovolné verze Microsoft data access objects (DAO) Databáze aplikace Access. Pøestože tato metoda není co odkazy, mùžete vytvoøit databázi aplikace Microsoft Access z aplikace Microsoft Excel sešit. Tuto metodu mìli použít, pouze pokud máte zkušenosti s Visual Basic for Applications a jsou dostateènì obeznámeni s aplikací Microsoft Access databáze lze upravovat tabulky vytvoøené pomocí tohoto kódu.

Jsou nìkteré kroky, které potøebujete-li zmìnit typy dat každého pole a zda chcete indexování.

Spoleènost Microsoft poskytuje ukázky programování pouze pro ilustraci bez žádné záruky výslovnì uvedené nebo pøedpokládané. Zahrnuje, ale neomezuje se pouze na pøedpokládaných záruk obchodovatelnosti nebo vhodnosti pro urèitý úèel. Tento èlánek pøedpokládá, že jste obeznámeni s programovacím jazykem, který je pøedmìtem ukázky a s nástroji, které slouží k vytvoøení a ladìní skriptu. Pracovníci podpory spoleènosti Microsoft mohou vysvìtlit funkce urèitého postupu, nemohou však tyto pøíklady funkce nebo konstrukce podle konkrétních požadavkù uživatele. Kód v tomto èlánku bude projít všechny listy v Microsoft Verze 7.0 sešit aplikace Excel a vytvoøit tabulku aplikace Access podle v kódu. Existuje nìkolik požadavkù pro tento kód funkce správnì.

Poznámka: Tyto požadavky jsou podobné co by vyžadováno, kdyby bylo pøenos dat pomocí odkazy.

Prosím zkontrolujte, zda sešit používají má seznam na každém listu skládající se z nejménì dvou sloupcù.

Požadavky jsou:

• Data musí být ve formì sloupec s názvy polí v prvním øádku. Zatímco dat mùže zaèít libovolného øádku, Tato podrutina pøedpokládá tento øádek 1 obsahuje názvy polí a nic pod øádek 1 je data Tabulka.
• Data musí být souvislá. Chybìjící záznamu dat nebude Tato podrutina nepøíznivì. Avšak po prázdný øádek. zjistil, podprogram bude pøedpokládat, že naètení všech údaje o aktuální list. Podobnì Jakmile je prázdný sloupec zjistil, podprogram bude pøedpokládat, že neexistují žádné další pole doprava.
• Každý sloupec bude považována za pole a každý øádek se považují záznam. Napøíklad data by mìla být nastavit takto:

        Lname              Fname       EmpNum     SpouseName
        Ebbeson            Frida          12         Dave
        Edelstein          Alex           15
        Edmonds            Cora           18         Paul
        Eliasen            Deborah        22         Tom
        Erickson           Gregory J      25         Lisa
        Fallon             Scott          23
        Feig               Wayne A.       35         Laurie
        Fetty              Ellen M.       54         James
  						

  Všimnìte si, že neúplné záznamy jsou povoleny.

Podprogram níže popsané bude takto:

• Deklaraci promìnných. Není vyžadováno, je užiteèné pro syntaxi Kontrola a snižování množství pamìti použít.
• Vypnutí aktualizace obrazovky. To bude urychlit podprogram spuštìní, Navíc se nezobrazí obrazovka flash.
• Vytvoøení databáze. První argument urèuje umístìní databáze bude, a jaký bude název. Vytvoøí nový podprogram databáze ve stejné složce jako sešit a se stejným názvem jako sešit (s pøíponou MDB). Pokud databáze již existuje. s tímto názvem do složky zprávou budou dotazem, zda je Chcete odstranit existující databázi. To je provádìno pøesahy, vytváøení: Chyba 3294 Databáze již existuje.
• Nastavení opakování projít všechny listy v sešitu.
  
  Poznámka: Protože moduly, listy s grafem a listy dialogù nejsou souèástí kolekce listu nebudou mít vliv podprogram.
• Ve smyèce listu vytvoøte tabulku na základì názvu listu.
• Zadejte smyèka prochází každým sloupcem v oblasti dat a vytvoøí pole v tabulce s názvem záhlaví sloupce. V Vytvoøte podprogram v èásti pole, je tøeba znát typ dat Pøiøazení nového pole. To provedete podprogram vyhledá buòky pøímo pod jeho a urèuje vlastnost formát èísla Buòka.
  
  Zadání pøíkazu Select Case, která vypadá vìtšina písmeno vlevo Vlastnost Formát èísla. Typ dat je vytvoøen, na základì toho písmeno. Pokud je vrácena "m", "d" nebo "y", typ dat je nastaven na "dbDate". Pokud je vrácena "G", k formátování buòky pod ní "Obecné". Pokud v takovém pøípadì je tøeba zjistit, zda buòka obsahuje èíslo nebo text.
  
  Otestujte, zda buòka obsahuje èíslo nebo text, podprogram pokusí se obsah buòky vydìlte èíslem 2. Pokud selže rozdìlení, rutinní kapek na popisovaè chyb, které urèuje, zda neshoda "Type" Chyba je. Pokud v takovém pøípadì se pole nastaveno na dbText. Pokud rozdìlení je úspìšná, podprogram klesne na další buòku dolù urèení, pokud tato divize bude úspìšná. To je nutné, protože je nutné urèit, že všechny záznamy obsahují dané èíslo pole pøed pøiøazením typu dat do formátu èísla. Pokud všechny Divize úspìšné, je pøiøazen typ dat dbDouble.
  
  Protože kontrola všech bunìk ve sloupci je èasovì nároèný proces. Na podprogram kontroluje pøítomnost "Zip" nebo "Postal" ve sloupci záhlaví. Dùvodem je, že by mìla být PSÈ a PSÈ Formát dbText. I když máte všechny pìtimístné PSÈ vašem listu, mùžete pøidat nìkteré den PSÈ èíslice 9. Pokud máte pole formátována jako "dbDouble", zobrazí se chybová zpráva Pøi pokusu o zadání poštovního plus ètyøi hodnoty. Hledání "Zip" nebo "Poštovní" snižuje èas procesoru pro vytvoøení pole.
  
  Pokud selžou všechny pøíkazy Select Case, pole nastaveno na dbText.
• Po vytvoøení všech polí na listu je pøidána všechna data v tabulce.
• Po pøidání všech dat do tabulky je vybrána další list a proces zaèíná znovu, dokud nebyly všechny listy vybrán a uložen jako tabulka.

        Sub DataToAccess()
       ' Declare variables.
       Dim Db As database
       Dim Rs As Recordset
       Dim Td As TableDef
       Dim Fd As Field
       Dim x As Integer
       Dim i As Integer
       Dim f As Integer
       Dim r As Integer
       Dim c As Integer
       Dim Message As String
       Dim Title As String
       Dim LastColumn As Integer
       Dim NumberTest As Double
       Dim StartCell As Object
       Dim LastCell As Object
       Dim Response
       Dim CreateFieldFlag As Integer
       Dim Flag As Integer
  
       CreateFieldFlag = 0
       Flag = 0
  
       ' Turn off Screen Updating.
       Application.ScreenUpdating = False
       On Error GoTo ErrorHandler
  
  
       ' Create the database.
       ' This line will create an Microsoft Access 2.0 database. To vary the
       ' version of the database, change the "dbVersion" constant.
       ' See "CreateDatabase" in online Help for more information.
       ' The database will be created in the same folder as the
       ' activeworkbook.
  
       Set Db = workspaces(0).CreateDatabase(ActiveWorkbook.Path & "\" & _
          Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) _
          & ".mdb", dbLangGeneral, dbVersion20)
  
       ' Loop through all the worksheets in the workbook.
       For i = 1 To Worksheets.Count
  
          ' Select the "i th" worksheet and Cell "A1."
          ' In this example, you need column headers in the first row.
          ' These headers will become field names.
          Worksheets(i).Select
          Range("A1").Select
  
          ' If the ActiveCell is blank, open a message box.
          If ActiveCell.Value = "" Then
              Message = "There is no data in the active cell: " & _
                  ActiveSheet.Name & "!" & ActiveCell.Address & Chr(10) & _
                  "Please ensure that all your worksheets have data on " & _
                  "them " & Chr(10) & _
                  "and the column headers start in cell A1" & Chr(10) & _
                  Chr(10) & "This process will now end."
  
              Title = "Data Not Found"
  
              MsgBox Message, , Title
              Exit Sub
          End If
  
          ' Create a new Table, and use the Worksheet Name as the
          ' Table Name.
          Set Td = Db.CreateTableDef(Worksheets(i).Name)
  
          ' Find the number of fields on the sheet and store the number
          ' of the last column in a variable.
          Selection.End(xlToRight).Select
          LastColumn = Selection.Column
  
          ' Select the current region. Then find what the address
          ' of the last cell is.
          Selection.CurrentRegion.Select
          Set LastCell = Range(Right(Selection.Address, _
              Len(Selection.Address) - _
              Application.Search(":", Selection.Address)))
  
          ' Go back to cell "A1."
          Range("A1").Select
  
          ' Enter a loop that will go through the columns and
          ' create fields based on the column header.
          For f = 1 To LastColumn
              Flag = 0
  
              ' Enter a select case statement to determine
              ' the cell format.
              Select Case Left(ActiveCell.Offset(1, 0).NumberFormat, 1)
                  Case "G"    'General format
                      ' The "General" format presents a special problem.
                      ' See above discussion for explanation
                      If ActiveCell.Value Like "*Zip*" Then
                          Set Fd = Td.CreateField(ActiveCell.Value, _
                              dbText)
                          Fd.AllowZeroLength = True
                          r = LastCell.Row - 1
                          Flag = 1
                      Else
                          If ActiveCell.Value Like "*Postal*" Then
                              Set Fd = Td.CreateField(ActiveCell.Value, _
                                  dbText)
                              Fd.AllowZeroLength = True
                              r = LastCell.Row - 1
                              Flag = 1
                          End If
                      End If
  
                      ' Set up a text to determine if the field contains
                      ' "Text" or "Numbers."
                      For r = 1 To LastCell.Row - 1
                          If Flag = 1 Then r = LastCell.Row
                          CreateFieldFlag = 1
                          NumberTest = ActiveCell.Offset(r, 0).Value / 2
                      Next r
  
                      ' If we get all the way through the loop without
                      ' encountering an error, then all the values are
                      ' numeric, and we assign the data type to be "dbDouble"
                      If Flag = 0 Then
  
                          Set Fd = Td.CreateField(ActiveCell.Value, dbDouble)
                      End If
  
                  ' Check to see if the cell below is formatted as a date.
                  Case "m", "d", "y"
                      Set Fd = Td.CreateField(ActiveCell.Value, dbDate)
  
                  ' Check to see if the cell below is formatted as currency.
                  Case "$", "_"
                      Set Fd = Td.CreateField(ActiveCell.Value, dbCurrency)
  
                  ' All purpose trap to set field to text.
                  Case Else
                      Set Fd = Td.CreateField(ActiveCell.Value, dbText)
                  End Select
  
              ' Append the new field to the fields collection.
              Td.Fields.Append Fd
  
              ' Move to the right one column.
              ActiveCell.Offset(0, 1).Range("A1").Select
  
          ' Repeat the procedure with the next field (column).
          Next f
  
          ' Append the new Table to the TableDef collection.
          Db.tabledefs.Append Td
  
          ' Select Cell "A2" to start the setup for moving the data from
          ' the worksheet to the database.
          Range("A2").Select
  
          ' Define the StartCell as the Activecell. All record addition
          ' will be made relative to this cell.
          Set StartCell = Range(ActiveCell.Address)
  
          ' Open a recordset based on the name of the activesheet.
          Set Rs = Db.OpenRecordset(Worksheets(i).Name)
  
          ' Loop through all the data on the sheet and add it to the
          ' recordset in the database.
          For x = 0 To LastCell.Row - 2
              Rs.AddNew
              For c = 0 To LastColumn - 1
                  Rs.Fields(c) = StartCell.Offset(x, c).Value
  
              Next c
              Rs.Update
          Next x
  
       ' Repeat the process for the next worksheet in the workbook.
       Next i
       Application.ScreenUpdating = True
       Exit Sub
  
  ErrorHandler:
       Select Case Err
          Case 3204   ' Database already exists.
             Message = "There has been an error creating the database." & _
                  Chr(10) & _
                  Chr(10) & "Error Number: " & Err & _
                  Chr(10) & "Error Description: " & Error() & _
                  Chr(10) & _
                  Chr(10) & "Would you like to delete the existing" & _
                  "database:" & Chr(10) & _
                  Chr(10) & ActiveWorkbook.Path & "\" & _
                  Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 4) & _
                  ".mdb"
              Title = "Error in Database Creation"
              Response = MsgBox(Message, vbYesNo, Title)
              If Response = vbYes Then
                  Kill ActiveWorkbook.Path & "\" & _
                    Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) -4) _
                    & ".mdb"
                  Message = ""
                  Title = ""
                  Resume
              Else
                  Message = "In order to run this procedure you need" & _
                      Chr(10) & "to do ONE of the following:" & _
                      Chr(10) & _
                      Chr(10) & "1.  Move the existing database to a " & _
                      "different directory, or " & _
                      Chr(10) & "2.  Rename the existing database, or" & _
                      Chr(10) & "3.  Move the workbook to a different " & _
                      "directory, or" & _
                      Chr(10) & "4.  Rename the workbook"
                  Title = "Perform ONE of the following:"
                  MsgBox Message, , Title
                  Message = ""
                  Title = ""
                  Exit Sub
              End If
  
          ' Check to see if the error was Type Mismatch. If so, set the
          ' file to dbText.
          Case 13 ' Type mismatch.
              If CreateFieldFlag = 1 Then
                  Set Fd = Td.CreateField(ActiveCell.Value, dbText)
                  Fd.AllowZeroLength = True
                  Flag = 1
                  r = LastCell.Row - 1
                  CreateFieldFlag = 0
                  Resume Next
              Else
                  Message = "You have a ""Type Mismatch"" in the code" _
                      & Chr(10) _
                      & Chr(10) & "Error Number: " & Err _
                      & Chr(10) & "Error Description: " & Error() _
                      & Chr(10) _
                      & Chr(10) & "This procedure will close."
  
                  Title = "Type Mismatch"
                  MsgBox Message, , Title
                  Message = ""
                  Title = ""
              End If
  
          ' For any other error, display the error.
          Case Else
             Message = "An error has occured in the procedure." _
                  & Chr(10) _
                  & Chr(10) & "Error Number: " & Err _
                  & Chr(10) & "Error Description: " & Error()
  
              Title = "An error has occured"
              MsgBox Message, , Title
              Message = ""
              Title = ""
       End Select
       End Sub

Aplikace Microsoft Access 97

Další informace o vytváøení indexù klepnìte na kartì Rejstøík v Nápovìda pro Microsoft Access, zadejte následující text:a potom poklepejte na pøechod "Vytvoøení indexu pro vybraný text rychlejší vyhledání a øazení záznamù."

Aplikace Microsoft Access verze 7.0

Další informace o indexování klepnìte v nabídce Nápovìda Prùvodce odpovìïmi v aplikaci Microsoft Access 7.0 zadejte: Index v Vyhledávací pole a klepnìte na tlaèítko "rozhodnout, zda a kdy použití indexu."

Aplikace Microsoft Access 2.0

Další informace o indexování hledání klepnìte v nabídce Nápovìda Aplikace Microsoft Access verze 2.0, typ Index v pole Hledat klepnìte na "Index (viz také indexy)" a klepnìte na tlaèítko "vytváøení je Index"podle témat.