PDA

Vollständige Version anzeigen : Messagebox code


mgernand
19.01.2001, 11:38
wunderschönen guten morgen wünsche ich.
mein problem ist ich habe ein programm geschrieben das im hintergrund einen connect zu einer anderen datenbank, die vom user gewählt werden muss, herstellt.
der user gibt einfach den namen der db in eine input box ein. wenn diese datenbank nicht existiert sprich der user hat sich vertippt... kommt diese fehlermeldung: Run-time error'3024' Couldn´t find file C:\Temp\*.mdb is ja auch ganz klar wenn die datenbank nicht existiert. :D mein code sieht hierzu folgendermaßen aus:

offen = InputBox("Geben Sie bitte den Namen ihrer Datenbank ohne *.mdb ein")

verz = ("C:\Temp\" & offen & ".mdb")

If Err.Number = 3024 Then
MsgBox ("Bitte überprüfen Sie die Pfadeingabe")
ElseIf Err.Number = 3024 Then
InputBox ("Geben Sie bitte den Pfad ihrer Datenbank ein")
End If

Set UserDB = DBEngine.Workspaces(0).OpenDatabase(verz)


die if..then..else anweissung überspringt access aber...beim debuggen springt es direkt zu Set UserDB....
hat jemand ne ahnung wie ich hier jetzt eine msgbox einbauen kann die dem user sagt das er den namen noch mal überprüfen soll wenn diese fehlermeldung erscheint. (der code der msgbox is klar)
thx im voraus
gruss marco

MarkusR
19.01.2001, 12:14
Einen ebensowunderschönen guten morgen :)

man kann auch einfach abtesten, ob die Datei existiert

verz = ("C:\Temp\" & offen & ".mdb")

do until len(dir(verz))=0
verz=inputbox("Bitte überprüfen Sie die Pfadeingabe. Geben Sie bitte den Pfad ihrer Datenbank ein","Datenbank wählen",verz)
if verz="" then 'Abbrechen gewählt
exit sub
end if
loop
Set UserDB = DBEngine.Workspaces(0).OpenDatabase(verz)

Viel Glück

Markus

mgernand
19.01.2001, 12:44
Danke Markus habe den code folgendermassen verwendet:
offen = InputBox("Geben Sie bitte den Namen ihrer Datenbank ohne *.mdb ein")
verz = ("C:\Temp\" & offen & ".mdb")
Do Until Len(Dir(verz)) = 0
verz = InputBox("Bitte überprüfen Sie die Pfadeingabe. Geben Sie bitte den Pfad ihrer Datenbank ein", "Datenbank wählen", verz)
If verz = "" Then Exit Sub
Loop
Set UserDB = DBEngine.Workspaces(0).OpenDatabase(verz)

das end if habe ich rausgenommen da er jedesmal die fehlermeldung end if without if brachte.. verstehe ich auch nicht.

trotzdem springt Access immer noch über die Inputboxen :(
hast du noch ne iddee :?
gruss marco

mgernand
19.01.2001, 12:50
ahh hab grade herausgefunden wenn ich
Set UserDB = DBEngine.Workspaces(0).OpenDatabase(verz) herauslasse funktioniert es nur wie baue ich jetzt die
verdingung auf *grml* ohh mann
gruss marco

MarkusR
19.01.2001, 12:51
Ich Riessenrhinozerus,

es muss natürlich heisen:


do until len(dir(verz))>0


mit =0 heist das

mache was in der schleife steht BIS die datei NICHT vorhanden ist :-D
(jaja, so langsam knurrt mein Magen, da lässt die Konzentration nach)
jetzt sollte es gehen

Gruß

Markus

robert_w
24.01.2001, 09:59
Es geht auch eleganter wenn man die Standard-Öffnen-Dialogbox nutzt:

Definiere folgenden Typ und Fkt:
Private Type typOpenFilename
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrfile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

' Windows API-Fkt für Standarddialogfelder
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" _
(pOpenfilename As typOpenFilename) As Long

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" _
(pOpenfilename As typOpenFilename) As Long

Private Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long

Private Const conOFN_HIDEREADONLY = &H4
Private Const conOFN_FILEMUSTEXIST = &H1000
Private Const conOFN_PATHMUSTEXIST = &H800

sowie folgende Funktion:
Public Function GetDatabase(ByVal strTitle As String, ByVal strFilename As String, Optional varPath As Variant) As String
Dim OpenFilename As typOpenFilename
Dim strMessage As String, strFilter As String, strFileTitle As String, strDefExt As String
Dim strDir As String, lngResult As Long, strFile As String * 255

On Error GoTo Err_GetDatabase

' für API-Fkt Strings mit Chr(0) beenden
strFilter = "Access(*.mdb)" & Chr$(0) & "*.MDB" & Chr(0)
If IsMissing(varPath) Then
strDir = CurDir & Chr(0)
Else
strDir = varPath & Chr(0)
End If
strTitle = strTitle & Chr(0)
' Puffer vorbelegen
strFile = Space(255)
strFile = strFilename & Chr(0)

With OpenFilename
.lStructSize = Len(OpenFilename)
.lpstrFilter = strFilter
.lpstrfile = strFile
.nMaxFile = Len(strFile)
.lpstrFileTitle = strTitle
.nMaxFileTitle = Len(strTitle)
.lpstrInitialDir = strDir
.nFilterIndex = 0
.flags = conOFN_HIDEREADONLY Or conOFN_PATHMUSTEXIST
End With

lngResult = GetOpenFileName(OpenFilename)
If lngResult = 0 Then
' Leere Zeichenfolge zurückgeben
GetDatabase = ""
Exit Function
Else
' Ergebniszeichenfolge aus API-Fkt rückwandeln
GetDatabase = Left(OpenFilename.lpstrfile, InStr(OpenFilename.lpstrfile, Chr(0)) - 1)
End If

Exit_GetDatabase:
Exit Function

Err_GetDatabase:
MsgBox "Fehler: " & Err.Number & " - " & Err.Description, vbExclamation
Resume Exit_GetDatabase

End Function

An der entsprechenden Stelle wo normalerweise die Inputbox steht setze:

strZielDB = GetDatabase("DB mit BP-Planzahlen", strDB, strPfad)

Damit wird an der Stelle die Standard-Dialogbox geöffnet.
strDB und strPfad sind hierbei die Voreinstellungen für DB-Name und Pfad
strZielDB der gewählte vollständige DB-Name
mit Pfad

Gruß Robert