[es] - Import excel fajla u access

Trtko
Koprivnica

Član broj: 69494
Poruke: 695
*.adsl.net.t-com.hr.

+8 Profil

^{19.06.2012. u 15:19 - pre 144 meseci}

' s ovime kodom bi otvorio explorer i odabrao excel tabelu

Dim lnkput As String
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
Dim vrtSelectedItem As Variant
With fd
.Filters.Clear
.Filters.Add "All files", "*.*"
.Filters.Add "Excel tablica", "*.xls", 1
If .Show = -1 Then
For Each vrtSelectedItem In .SelectedItems
lnkput = vrtSelectedItem
Label59.Caption = vrtSelectedItem
Next vrtSelectedItem
Else
End If
End With
Set fd = Nothing

If IsNull(lnkput) Or lnkput = "" Then
MsgBox "Niste odabrali nijednu excel TABLICU "
Exit Sub
End If

' ovdje dolje sam prepisivao 1 polje iz neke navedene kolone, ako malo prepravis mozes i iz vise kolona prepisivati u tablicu

' upis u finitem iz excela

Dim dato2 As Database
Dim rek2 As Recordset
Set dato2 = CurrentDb
Dim sqlupit2 As String
sqlupit2 = "select * from finitem"
Set rek2 = dato2.OpenRecordset(sqlupit2)

brprep = 0
impdef = 3

kolona = InputBox("Unesi broj kolone u kojoj se nalazi iznos (npr. kolona A=1, C=3) " & Chr(13) & "Konta će se prepisati iz prve kolone (A). Prepisivanje počinje od 1. završava u 1000. redu. Prepisivat će se vrijednosti onih konta koji imaju 6 ili više znakova", "Import iz EXCELA", impdef)

If IsNull(kolona) Or kolona = "" Then
MsgBox "Niste Izabrali"
Exit Sub
End If
kol = Val(kolona)
Set objexcel = CreateObject("Excel.Application")
objexcel.Workbooks.Open (lnkput)

sveukupno = 0
For j = 1 To 1000

konto = objexcel.Cells(j, 1).Value
iznos = objexcel.Cells(j, kol).Value

If Len(Trim(konto)) = 6 Then

If IsNumeric(konto) = True Then
If IsNumeric(iznos) = False Then
MsgBox "Niste odabrali dobru kolonu za prepis. Vrijednost u koloni = " + iznos
Exit Sub
End If
brprep = brprep + 1
rek2.AddNew
rek2.Fields("AccountID") = konto
rek2.Fields("Accountvalue") = iznos
rek2.Fields("Statementid") = 2
sveukupno = sveukupno + iznos
rek2.Update
End If
End If
Next j

rek2.Close
Set dato2 = Nothing

objexcel.Application.DisplayAlerts = False
objexcel.Application.Quit
objexcel.Application.DisplayAlerts = True
[Forms]![unos]![FinStatment].Requery
MsgBox "Podaci za Plan su prepisani, Prepisano: " + Trim(Str(brprep)) + " konta" & Chr(13) & "Sveukupno : " & Format$(sveukupno, "###,###,###,###.00")

Odgovor na temu

Zidar
Canada

Moderator
Član broj: 15387
Poruke: 3085
*.100.46-69.q9.net.

+79 Profil

Re: Import excel fajla u access

^{19.06.2012. u 16:25 - pre 144 meseci}

Import/Link se radi u nekoliko koraka.

Osnova za import/link je Docmd.TransfreDatasheet metod. Ovako:

Code:

DoCmd.TransferSpreadsheet TransferType:=intLinkOrImport _
                        , SpreadsheetType:=acSpreadsheetTypeExcel7 _
                        , TAbleName:=strTargetTable _
                        , FileName:=strFileName _
                        , HasFieldNames:=True

Imamo mnogo parametara, sve o njima mozes naci u Help ako otkucas 'Display and Use the File Dialog Box'

Problematican parametar je FileNAme, tu moras da zadas bnesto kao "D:\Podaci\MojExeclFile.XLS"
Kako doci do naziva fajla i putanje - preko OpenFile dialog boxa. U primeru koji sam zakacio, koristiom ono sto nudi Access 2007 pa nagore. Mislim da moze i u 2003. AKo imas 2003, u temi "Baza znanja" imas primer kako se otvara OpenFile dialog box na starinski, stari dobri porvereni nacin.

Jos jedna stvar na koju treba paziti: kad se tabele importuju (TransferType := acImport), Access ce podatke iz Excela dodati (kao Append) na postojecu tabel i podatke.. Ako tabela ne postoji, Access ce je kreirati.

Ako linkujes podatke (TransferType := acLink), i vec postoji linkovana tabela sa istim imenom, Access ce napraviti dodatni link, sa istim imenom ali na kraju imena dodaje broj (tblLink, tblLink1, tblLink2 i tako dalje). Ako se to ne zeli, treba prvo otkaciti postojeci link. To se radi tako sto s eobrise table-def objekt.

Sve u svemu, trebaju ti tri funkcije:

Glavna funkcija, koja poziva druge dve:
LinkOrImportExcelFileAsTable(intLinkOrImport As Integer, strTargetTable As String, Optional flgRelink As Boolean = False) As Boolean
Ovo su pomocne funkcije:
GetExcelFilePAth() As String
DeleteTableDef(strTargetTable As String) As Boolean

U zakacenom primeru imas sve tri funkcije i jos objasnjenja u komentarima.

Nadam se da je pomoglo

Prikačeni fajlovi

ImportIzExcelaUTAbelu.rar - 23.5k

Odgovor na temu