Private Sub CommandButton1_Click()
Dim accApp As Object
Dim sPath As String
Warning = MsgBox("Achtung: Mit Schalter [sichern] in Access, wird eine neue Excelinstanz geöffnet." & (Chr(13)) _
& "Deshalb müssen alle offenen Excel-Datein geschlossen sein! " & (Chr(13)) _
& " Mit [JA] werden alle offene Dateien gesichert und geschlossen." & (Chr(13)) _
& " Mit [Nein] wird diese Aktion beendet.", vbYesNo, "Access wird geöffnet ein Datensatz wird übernommen (c) Fred")
If Warning = 7 Then End
sPath = "C:\Eigene Dateien\DB-Fred\Zeitstempel1.mdb" ' anpassen
If Dir(sPath) = "" Then
MsgBox "Access-Datenbank wurde nicht gefunden!"
Else
Set accApp = CreateObject("Access.Application")
accApp.OpenCurrentDatabase sPath
accApp.Visible = True
End If
For Each w In Application.Workbooks
w.Save
Next w
Application.Quit
End Sub
Private Sub Befehl6_Click() 'mit Button Click
On Error GoTo Err_Befehl6_Click
Dim KeyString As String
Dim KeyString1 As String
Dim KeyString2 As String
stDocName = "Kontaktanzeige"
KeyString = Me!KdNummer
KeyString1 = Me!Key_Wort
KeyString2 = Me!KdName
'*******wenn aus anderer Form*******
'KeyString = Forms![Kundensuchen]![KdNummer]
'KeyString1 = Forms![Kundensuchen]![Key_Wort]
'KeyString2 = Forms![Kundensuchen]![KdName]
Richtig = MsgBox("Kunde " & KeyString2 & " wurde markiert" & (Chr(13)) & (Chr(13)) & "Mit [ NEIN ] zurück", vbYesNo, "Hallo Uwe")
If Richtig = 7 Then End
DoCmd.SetWarnings False
DoCmd.RunSQL "INSERT INTO Kontakte ( Key_Wort, KdNummer, KdName, Datum, letzte_Aktion, Kontaktart ) " & _
"SELECT '" & KeyString1 & "' AS Ausdr1, " & KeyString & " AS Ausdr2, '" & KeyString2 & "' AS Ausdr3, Now(), 'Nachicht' AS Ausdr5, '1';"
'*********Nur Datum ohne Zeit als String******
'"SELECT '" & KeyString1 & "' AS Ausdr1, " & KeyString & " AS Ausdr2, '" & KeyString2 & "' AS Ausdr3, #" & DatePart("m", Now()) & "/" & DatePart("d", Now()) & "/" & DatePart("yyyy", Now()) & "#" & ", 'Nachicht' AS Ausdr5, '1' AS Ausdr6;"
DoCmd.OpenForm stDocName
'DoCmd.GoToRecord , , acNewRec
Exit_Befehl6_Click:
Exit Sub
Err_Befehl6_Click:
MsgBox Err.Description
Resume Exit_Befehl6_Click
End Sub
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen