Strona: [  << <   1   > >>  ]  z  1     
Autor Temat: Z Excella do Accessa
Wlodi




Typ: neutral
Postów: 5
Zarejestrowany: May 2004
Z Excella do Accessa

Witam
Mam w Excelu tabelke ,w której jest kilka tysięcy pozycji
Czy jest jakiś sposób na szybkie przeniesienie danych z tej tabelki do tabelki w accessie?

13-05-2004 13:20
Pokaż profil Wlodi  Wyślij email do Wlodi   
losmac
"profesorek"




Typ: neutral
Postów: 758
Zarejestrowany: May 2003
conajmniej dwa

Są conajmniej 2 sposoby:

1) Polecenie Impotuj w oknie bazy danych Access'a
2) Programowo

Pierwszy jest "zwykłych użytkowników"
Drugi dla programistów

Sub ToAccess()
Dim dbs As Database
Dim rst As Recordset 'tabela lub kwerenda
Dim zap As String 'nazwa tabeli
Dim i As Long

'tu możesz określić nazwę tablei lub
'zapytanie SQL, w przykładzie stosuję SQL
zap = "tabela"

On Error GoTo Err_ToAccess

i = 1

'otwórz bazę danych
'zmień ścieżkę dostępu
Set dbs = OpenDatabase(ThisWorkbook.Path & "\a.mdb"
Set rst = dbs.OpenRecordset(zap)
Do While ThisWorkbook.Worksheets("Arkusz1".Range("A" & i)
    rst.AddNew
    rst.Fields("Pole1" = ThisWorkbook.Worksheets("Arkusz1".Range("A" & i)
    'rst.Fields("Pole2" = ThisWorkbook.Worksheets("Arkusz1".Range("B" & i)
    rst.Update
    i = i + 1
Loop

Exit_ToAccess:
    On Error Resume Next
    rst.Close
    dbs.Close
    Set rst = Nothing
    Set dbs = Nothing
    Exit Sub

Err_ToAccess:
    Resume Exit_ToAccess
End Sub


_____________________________________________
POSTULATY STARUSZKA:
1) Ludzie, dbajcie o polszczyznę!!!
2) Ludzie, zadawajcie kompletne pytania, a nie rzucacie ochłapy i trzeba się domyślać o co chodzi!!!

Powodzenia
Maciej Łoś

13-05-2004 21:44
Pokaż profil losmac  Wyślij email do losmac   Odwiedź stronę losmac  
Wlodi




Typ: neutral
Postów: 5
Zarejestrowany: May 2004

Dzięki wielkie za pomoc.Analizuje kod ,jesli czegoś nie będę mógł rozgryżć zgłosze się.

[Post edytowany dnia 14-05-2004 19:44 przez Wlodi]

14-05-2004 19:40
Pokaż profil Wlodi  Wyślij email do Wlodi   
karolinavb




Typ: neutral
Postów: 468
Zarejestrowany: Jan 2003

Można też poćwiczyć inaczej:
Option Explicit
' to jest przykład wołany z modułu VBA w Excelu analogicznie mozna to zrobić z VB
' VBA Tools/Reference - Microsoft ADO 2.0 Data Object Library
' VBA Tools/Reference - Microsoft ADO Ext 2.7 for DDL and Security
' zakładam, że dane wpisane są w skoroszycie sExcelXls w arkuszu sSheetName
' od  góry (może być z nagłowkami wówczas HDR=YES) w kolumnach


Sub ExcelToMdb()
' nazwa Skoroszytu ze ścieżka
' tak najprościej

On Error GoTo lerror
Dim sExcelFile As String
'nazwa Skoroszytu
Dim sExcelXls As String
' nazwa arkusza
Dim sSheetName As String
' nazwa bazy danych
Dim sBaseName As String
' nazwa tabeli do której dodajemy
Dim sTableName As String
' nazwa bazy danych ze ścieżka
Dim sMdbFile As String
' nazwa nowej tabeli, jeśli tworzymy
Dim sNewTableName As String
' kwerenda dodająca do tabeli
Dim sSqlAppend As String
' kwerenda tworzaca nową tabelę
Dim sSqlTableCreate As String

Dim oConExcel As ADODB.Connection

sBaseName = "MyNewExcel.mdb"
sTableName = "ExToAcc"
sNewTableName = "ExToAccNew"

' ścieżka do arkusza xls
' albo ewentualnie np jak poniżej i wtedy ścieżka
' bez ThisWorkBook gdy wywołujemy z innego arkusza
' sExcelXls = "Excel2Mdb.xls"
' sSheetName = "MyArk1"

With ThisWorkbook
    ' na przykład
    sExcelXls = .Name
    'na przykład
    sSheetName = .Sheets(1).Name
    ' albo ewentualnie
    ' sExcelXls = "Excel2Mdb.xls"
    ' sSheetName = "MyArk1"


sExcelFile = .Path _
    & IIf(Right$(.Path, 1) <> "\", "\", "" ) _
    & sExcelXls

' ścieżka do bazy danych
sMdbFile = .Path & _
    IIf(Right$(.Path, 1) <> "\", "\", "" ) & _
    sBaseName
End With
' IsCreatedMDB mozna pominąc jeśli chcemy
' jest tu tylko przytoczona dla wieloktrotnego
' i przykładowego uruchamiania modułu


If IsCreatedMDB(sMdbFile, sTableName, sNewTableName) Then
    ' połączenie
    Set oConExcel = New ADODB.Connection
    With oConExcel
        ' Jet w wersji jaką mamy
        .ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
            & "Data Source=" & sExcelFile & ";" & _
            "Extended Properties=""Excel 8.0;HDR=NO;IMEX=1"""
            'lub Excel 10.0 - zależnie od wersji
        .Open
   
    ' kwerenda tworzaca nową tabelę
    sSqlTableCreate = "SELECT * INTO " & sNewTableName & _
            " IN '" & sMdbFile & "' " & _
            " FROM [" & sSheetName & "$]"
    ' kwerenda dodająca do tabeli
    sSqlAppend = "INSERT INTO " _
        & sTableName _
        & " IN '" & sMdbFile & "' " _
        & " SELECT * FROM [" & sSheetName & "$]"
        ' dodajemy do tabeli sTableName
        .Execute sSqlAppend
        ' albo nową tabelę sNewTableName
        .Execute sSqlTableCreate
    End With
End If
Exit Sub
lerror:
    MsgBox (Err.Description & "  " & Err.Number)
End Sub
' Funkcja ponizsza oczywiście jest tu przytocznona tylko aby pokazać,że można tak też tworzyć baze, tabele i usuwać itd...nie jest konieczne korzystanie z niej

Function IsCreatedMDB(ByVal sMdbFile As String, _
    ByVal sTableName As String, ByVal sNewTableName As String) As Boolean
' funkcja tworzy baze sMdbFile gdy jej nie ma
' tworzy tabele, którą uważamy za istniejącą sTableName
' i chcemy dodać do niej dane z arkusza kwerendą sSqlAppend
' jesli nie istnieje i jej przykładowe pola

' usuwa tabelę sNewTableName , którą
' chcemy stworzyc kwerendą sSqlTableCreate

On Error GoTo lerror ' tak najprościej
IsCreatedMDB = False
Dim bNewCreated As Boolean
Dim i As Long
Dim bsTableName As Boolean
Dim oCat As ADOX.Catalog
Dim tbl As ADOX.Table

bsTableName = False
bNewCreated = False

Set oCat = New ADOX.Catalog
'uzycie providera wersji 3.51 -utworzenie bazy w formacieAccessa 97 ; providera w wersji 4 - Access 2000

If Dir(sMdbFile) = "" Then
    ' jesli nie ma bazy sMdbFile ewentualnie stworzenie bazy
    oCat.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & sMdbFile
    bNewCreated = True
Else
    'jak jest baza to tylko połaczenie do sMdbFile
    oCat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & sMdbFile
End If
If Not bNewCreated Then
    For Each tbl In oCat.Tables
        With tbl
            ' czy jest na pewno tabela do której chcemy dodawać dane
            If .Name = sTableName Then
                bsTableName = True
                Exit For
            End If
        End With
    Next
    For Each tbl In oCat.Tables
        ' czy jest tabela którą chcemy tylko stworzyć na podstawie danych z Excela
        With tbl
            If .Name = sNewTableName Then
            ' usuńmy stowrzymy ją kwerendą w funkcji wywołującej
              oCat.Tables.Delete (.Name)
              Exit For
            End If
        End With
    Next
    Set tbl = Nothing
    If Not bsTableName Then
      ' jesli nie było tabeli, która uważamy za istniejącą czyli sTableName
        Set tbl = New ADOX.Table
        With tbl
            .Name = sTableName
            For i = 1 To 4
                ' przykładowo dodajmy pola F1,F2,F3,F4
                .Columns.Append "F" & CStr(i), adVarWChar, 50
                'dla wersji 3.51: odpowiednio .Columns.Append "F" & CStr(i), adVarChar, 50
            Next
            oCat.Tables.Append tbl
        End With
        Set tbl = Nothing
    End If
End If
Set oCat = Nothing
IsCreatedMDB = True
Exit Function
lerror:
    IsCreatedMDB = False
    MsgBox (Err.Description & "  " & Err.Number)

End Function

Pozdrawiam - Karolina
P.S. Kobiety są gadatliwe tak już jest...


_____________________________________________
Karolina

15-05-2004 15:08
Pokaż profil karolinavb  Wyślij email do karolinavb   
Wlodi




Typ: neutral
Postów: 5
Zarejestrowany: May 2004

Thx
Tego także spróbuje

15-05-2004 19:20
Pokaż profil Wlodi  Wyślij email do Wlodi   
anonim




Typ: Nie zarejestrowany
Co to za typy danych Database i Recordset ?

Nie ma takich typów danych w VBA
Nie mam zbyt dużego doświadczenia w VBA, ale co rozumiesz przez ?
Dim dbs As Database
Dim rst As Recordset
Sam zdefiniowales te typy ?
Tez jestem zainteresowany tym problemem, a opis Karoliny jest bardziej zrozumialy

21-07-2005 15:39
  
Wszystkich odpowiedzi: 5 :: Maxymalnie na stronę: 20
Strona: [  << <   1   > >>  ]  z  1