Makro Ms Access - Na Access makro VBA do kopiowania tabel

Question

Mam problem, że muszę utworzyć kod VBA dla MS Access 2016, który skopiuje zawartość tabeli 1 do tabeli 2 z dwoma warunkami1.) Jeśli nie znajdzie dup...

PRL · Accepted Answer

Masz świadomość tego, że żeby Ci przedstawić poprawny kod, to trzeba do testów stworzyć bazę z tabelami i formularzem?
Może i to niedużo roboty, ale zawsze zajmuje czas...
Akces, to nie tabelka w Excelu. Im dalej w las, tym więcej przed Tobą problemów i pytań, skoro taki prosty kod (skopiowany z sieci) jest dla Ciebie problemem.

Log in, to see the code

PRL · Accepted Answer

Pisać programu nie da się metodą kopiuj/wklej.Edytor VB zgłosił błąd i napisał w czym problem.

PRL · Accepted Answer

Jak nie chcesz mieć duplikatów, to załóż na pole Data indeks bez powtórzeń.

PRL · Answer

Nie da się przerobić tego kodu nie znając struktur tabel i nazwy pola, które może się duplikować.

tomo999999999 · Answer

W obu tabelach są takie same pola a sprawdzane ma być pole data pod względem duplikatów

PRL · Answer

Code: sqlLog in, to see the codeCode: sqlLog in, to see the code

tomo999999999 · Answer

A jak to będzie wyglądać w kodzie VBA?

tomo999999999 · Answer

Tak dziękuję.

Mam jeszcze problem taki jak na zdjęciu

To mój kod

1.) Kod 1

Private Sub txtVWI_BeforeUpdate(Cancel As Integer)
On Error GoTo Err_txtVWI_BeforeUpdate
Dim intResponse As Integer
Dim strTable As String
Dim strFind As String
Dim strSQL As String
Dim rst As ADODB.Recordset
Dim Conn As ADODB.Connection
Set Conn = CurrentProject.Connection
Set rst = New ADODB.Recordset
strTable = "Główna"
strSQL = "SELECT Count(Główna.Data/Godzina) AS Duplikaty" & _ " FROM Główna" & _ " GROUP BY Główna.Data/Godzina" & _ " HAVING Count(Główna.Data/Godzina)>1"
Set rs = db.OpenRecordset(strSQL) If rs.RecordCount = 0 Then
strSQL = "INSERT INTO Główna" & _ " SELECT Tymczasowa.*" & _ " FROM Tymczasowa" DoCmd.RunSQL (strSQL)
rst.Open strSQL, Conn
If rst(0) > 0 Then ' duplikaty znalezione.
If Me.NewRecord Then
intResponse = MsgBox("Ten zestaw danych już istnieje" & vbCrLf & "chcesz zduplikować zestaw danych?", vbYesNo)
If intResponse = vbNo Then
Me.Undo
End If
End If
End If
Exit_txtVWI_BeforeUpdate:
Exit Sub

rst.Close
Conn.Close
Set rst = Nothing
Set Conn = Nothing
Err_txtVWI_BeforeUpdate:
MsgBox Err.Description
Resume Exit_txtVWI_BeforeUpdate
End Sub

2.) Kod 2

Private Sub DodlaczDoTabeli_Click() Dim db As Database Set db = CurrentDb Dim rs As DAO.Recordset strSQL = "SELECT Count(Główna.[Data/Godzina]) AS Duplikaty" & _ " FROM Główna" & _ " GROUP BY Główna.[Data/Godzina]" & _ " HAVING Count(Główna.[Data/Godzina])>1" Set rs = db.OpenRecordset(strSQL) If rs.RecordCount = 0 Then strSQL = "INSERT INTO Główna" & _ " SELECT Tymczasowa.*" & _ " FROM Tymczasowa" DoCmd.RunSQL (strSQL) MsgBox "Dodano dane do tabeli.", vbInformation, "Informacja" Else i = MsgBox("Są " & rs(0) & " duplikaty. Nie kopiuję!", vbCritical, "UWAGA") End If rs.Close Set rs = Nothing Set db = Nothing End Sub

A tu jaki błąd mi wyskakuję

Bardzo proszę o pomoc.
Pozdrawiam.

tomo999999999 · Answer

Dziękuję za pomoc

Mam jeszcze jedno pytanie jak zrobić aby porównywał obie tabele czyli tabele 2 z tabelą 1 porównanie po rekordzie data i jak nie ma duplikatów to kopiuje a jak są duplikaty to pyta czy kopiować czy przerwać.

Pozdrawiam serdecznie.

Dodano po 29 [minuty]:

Możesz polecić jakiś dobry kurs?

tomo999999999 · Answer

Cześć,Mam jeszcze jeden problem:Run-time error '3061'Za mało parametrów . Oczekiwano 2.Set rs = db.OpenRecordset(strSQL)Dołączam też zdjęcia.Bardzo proszę o pomocPozdrawiam.

PRL · Answer

Jak nie chcesz używać nawiasów kwadratowych, to odpowiednio nazywaj tebele i pola, a jak masz, jak masz, to:

Log in, to see the code

P.S. Na przyszłość usuń '/' z nazwy daty i godziny.

tomo999999999 · Answer

Dziękuję działa

A możesz mi powiedzieć czemu ten kod nie działa i jak go uruchomić bo siedzę nad nim i nie mam pojęcia o co chodzi poproszę:

Private Sub txtVWI_BeforeUpdate(Cancel As Integer)
On Error GoTo Err_txtVWI_BeforeUpdate
Dim intResponse As Integer
Dim strTable As String
Dim strFind As String
Dim strSQL As String
Dim rst As ADODB.Recordset
Dim Conn As ADODB.Connection
Set Conn = CurrentProject.Connection
Set rst = New ADODB.Recordset
strTable = "Główna"
strSQL = "SELECT Count([Główna].[Data/Godzina]) AS Duplikaty" & _
" FROM Główna" & _
" GROUP BY [Główna].[Data/Godzina]" & _
" HAVING Count([Główna].[Data/Godzina])>1"
Set rs = db.OpenRecordset(strSQL)
If rs.RecordCount = 0 Then strSQL = "INSERT INTO Główna" & _
" SELECT Tymczasowa.*" & _
" FROM Tymczasowa"
DoCmd.RunSQL (strSQL)
rst.Open strSQL, Conn
If rst(0) > 0 Then ' duplikaty znalezione.
If Me.NewRecord Then
intResponse = MsgBox("Ten zestaw danych już istnieje" & vbCrLf & "chcesz zduplikować zestaw danych?", vbYesNo)
If intResponse = vbNo Then
Me.Undo
End If
End If
End If
Exit_txtVWI_BeforeUpdate:
Exit Sub

rst.Close
Conn.Close
Set rst = Nothing
Set Conn = Nothing
Err_txtVWI_BeforeUpdate:
MsgBox Err.Description
Resume Exit_txtVWI_BeforeUpdate
End Sub

PRL · Answer

Umieść kod w znacznikach i sformatuj go (wcięcia), bo tego się nie da czytać.

tomo999999999 · Answer

Code: text Expand Select all Copy to clipboard
Private Sub txtVWI_BeforeUpdate(Cancel As Integer)
On Error GoTo Err_txtVWI_BeforeUpdate
Dim intResponse As Integer
Dim strTable As String
Dim strFind As String
Dim strSQL As String
Dim rst As ADODB.Recordset
Dim Conn As ADODB.Connection
Set Conn = CurrentProject.Connection
Set rst = New ADODB.Recordset
strTable = "Główna"
strSQL = "SELECT Count([Główna].[Data/Godzina]) AS Duplikaty" & _
" FROM Główna" & _
" GROUP BY [Główna].[Data/Godzina]" & _
" HAVING Count([Główna].[Data/Godzina])>1"
Set rs = db.OpenRecordset(strSQL) 
If rs.RecordCount = 0 Then strSQL = "INSERT INTO Główna" & _ 
" SELECT Tymczasowa.*" & _
" FROM Tymczasowa"
DoCmd.RunSQL (strSQL)
rst.Open strSQL, Conn
If rst(0) > 0 Then ' duplikaty znalezione.
If Me.NewRecord Then
intResponse = MsgBox("Ten zestaw danych już istnieje" & vbCrLf & "chcesz zduplikować zestaw danych?", vbYesNo)
If intResponse = vbNo Then
Me.Undo
End If
End If
End If
Exit_txtVWI_BeforeUpdate:
Exit Sub

rst.Close
Conn.Close
Set rst = Nothing
Set Conn = Nothing
Err_txtVWI_BeforeUpdate:
MsgBox Err.Description
Resume Exit_txtVWI_BeforeUpdate
End Sub

PRL · Answer

Pomieszałeś dwa różne kody. Tak się nie da.Co chcesz osiągnąć?

tomo999999999 · Answer

Chodzi mi oto aby sprawdzał 2 tabelę Główną i Tymczasową czy są duplikaty i jeśli są to wyświetla informację że są duplikaty i czy wgrać czy przerwać.

Czyli:

Porównuje tabelę tymczasową z główną po dacie i jak znajdzie duplikaty w tabeli głównej to informuje o duplikatach i pyta czy wgrać rekordy mimo to.

PRL · Answer

I tak chcesz każdą datę z Tymczasowej sprawdzać w Głównej pod kątem występowania duplikatów???

tomo999999999 · Answer

Tak chcę zrobić

PRL · Answer

A co ma się dziać, gdy duplikatów nie ma?
I czy duplikat w Głównej jest wtedy, gdy są w niej dwie takie same daty, czy duplikat nastąpi dopiero po dodaniu z Tymczasowej do Głównej?
Chcesz pisać program, a nie potrafisz sprecyzować o co Tobie chodzi.

Log in, to see the code

tomo999999999 · Answer

Jeśli nie znajdzie duplikatów Data/Godzina w tabeli Tymczasowa i Główna to dodaje rekordy z tabeli Tymczasowa do Główna
A jak znajdzie duplikaty w tabeli Główna które występują też w tabeli Tymczasowej w kolumnie Data/Godzina to wyświetla komunikat o duplikatach i pyta czy kontynuować jeśli tak to mamy 3 opcje:

1.) Dodaj z duplikatami
2.) Zamień dane
3.) Anulować

Mam nadzieję że teraz lepiej opisałem.

PRL · Answer

3. Rób co chcesz, to tylko baza danych.

tomo999999999 · Answer

Możesz mi pomóc poproszę dopiero zaczynam a jest mi to bardzo potrzebne

PRL · Answer

Powyszy kod rozwiązuje temat, więc nie zaśmiecajmy forum. Reszta na PW.

[Solved] Makro Ms Access - Na Access makro VBA do kopiowania tabel