Ich möchte dem Benutzer eine Möglichkeit bieten per Auswahl- oder direktem Eingabefeld einen Pfad zu hinterlegen, in welchem ein Word-Doc liegt.
Mit Knopfdruck soll dann dieses Word-Doc gestartet werden. Am besten so, daß auch gleichzeitig Word mitgeöffnet wird.
Danke für die Hilfe!
Zunächst brauchst Du also eine Möglichkeit den Pfad + Dateiname zu hinterlegen. Hierzu benutzt Du API-Function-Calls, da Du damit das reguläre Datei-Öffnen-Dialogfeld von Windows aufrufst. Kopiere also folgenden Code in ein neues Modul und rufe dann die Funtion FindFileName auf, die dann als Rückgabe den Dateinamen in Dein Formularfeld überträgt.
Option Compare Database
'=======================================================================================
'FindFileName(Optional Dateiart, Optional strSearchPath) As String
’ Öffnet das Datei öffnen Dialogfeld und liefert den Pfad und die Datei zurück
’ Dateiarten: „XLS“, „XL?“, „DOC“, „DOT“, „DO?“, „MDB“, „MD?“ , „HTM“
’ Aufruf ohne Dateiart, dann gilt Dateiart „*.*“
'=======================================================================================
'Einstellungen für das Datei-Öffnen-Dialogfeld:
Declare Function HoleAuflösung Lib „user32“ Alias „GetSystemMetrics“ (ByVal nIndex%) As Integer
Declare Function getopenFileName Lib „comdlg32.dll“ Alias „GetOpenFileNameA“ (pOpenFileName As OPENFILENAME) As Boolean
Type MSA_OpenfileName
strFilter As String
lngFilterIndex As Long
strINitialDir As String
StrInitialFile As String
strDialogTitle As String
strDefaultExtension As String
lngFlags As Long
StrFullPathReturned As String
StrFileNameReturned As String
intFileOffset As Integer
intFileExtension As Integer
End Type
Const ALLFILES = „Alle Dateien“
Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As Long
nMaxCustrFilter 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
lCustrData As String
lpfnHook As Long
lpTemplatename As Long
End Type
Const OFN_ALLOWMULTISELECT = &H200
Const OFN_CreatePrompt = &H2000
Const OFN_Explorer = &H80000
Const OFN_FileMustExist = &H1000
Const OFN_HideReadOnly = &H4
Const OFN_NoChangeDir = &H8
Const OFN_NodeReferencelinks = &H100000
Const OFN_NonetworkButton = &H20000
Const OFN_NoReadonlyReturn = &H8000
Const OFN_NovaliDate = &H100
Const OFN_Overwriteprompt = &H2
Const OFN_PathmustExist = &H800
Const OFN_Readonly = &H1
Const OFN_ShowHelp = &H10
Function FindFileName(Optional Dateiart, Optional strSearchPath, Optional Überschrift) As String
Dim msaof As MSA_OpenfileName
If IsMissing(strSearchPath) = False Then msaof.strINitialDir = strSearchPath
If IsMissing(Überschrift) = True Then
Select Case Dateiart
Case „MDB“
msaof.strDialogTitle = „Wo befindet sich die Daten-Datei?“
Case „MD?“
msaof.strDialogTitle = „Wo befindet sich die Datei?“
Case „XLS“
msaof.strDialogTitle = „Wo befindet sich die Excel-Datei?“
Case „XL?“
msaof.strDialogTitle = „Wo befindet sich die Excel-Datei?“
Case „DOC“
msaof.strDialogTitle = „Wo befindet sich die Word-Datei?“
Case „DOT“
msaof.strDialogTitle = „Wo befindet sich die Word-Vorlage?“
Case „DO?“
msaof.strDialogTitle = „Wo befindet sich die Word-Datei?“
Case „HTM“, „HTML“
msaof.strDialogTitle = „Wo befindet sich die HTML-Datei?“
Case Else
msaof.strDialogTitle = „Wo befindet sich die Datei?“
End Select
Else
msaof.strDialogTitle = Überschrift
End If
If IsMissing(Dateiart) = False Then
Select Case Dateiart
Case „MDB“
msaof.strFilter = MSA_CreateFilterString(„Datenbanken“, „*.MDB“)
Case „MD?“
msaof.strFilter = MSA_CreateFilterString(„Datenbanken“, „*.MDB; *.MDA; *.MDW“)
Case „XLS“
msaof.strFilter = MSA_CreateFilterString(„Excel-Dateien“, „*.XLS“)
Case „XL?“
msaof.strFilter = MSA_CreateFilterString(„Excel-Dateien“, „*.XLS; *.XLT; *.XLA“)
Case „DOC“
msaof.strFilter = MSA_CreateFilterString(„Word-Dateien“, „*.DOC“)
Case „DOT“
msaof.strFilter = MSA_CreateFilterString(„Word-Vorlagen“, „*.DOT“)
Case „DO?“
msaof.strFilter = MSA_CreateFilterString(„Word-Dateien“, „*.DOT; *.DOC“)
Case „HTM“, „HTML“
msaof.strFilter = MSA_CreateFilterString(„HTML-Dateien“, „*.HTM; *.HTML“)
Case Else
msaof.strFilter = MSA_CreateFilterString(„Alle Dateien“, „*.*“)
End Select
Else
msaof.strFilter = MSA_CreateFilterString(„Datenbanken“, „*.MDB“)
msaof.strDialogTitle = „Wo befindet sich die Daten-Datei?“
End If
MSA_GetOpenFileName msaof
FindFileName = Trim(msaof.StrFullPathReturned)
End Function
Function MSA_GetOpenFileName(msaof As MSA_OpenfileName) As Integer
’ Öffnet das Dialogfeld Datei öffnen.
Dim of As OPENFILENAME
Dim intRet As Integer
MSAOF_to_OF msaof, of
intRet = getopenFileName(of)
If intRet Then
OF_to_MSAOF of, msaof
End If
MSA_GetOpenFileName = intRet
End Function
Private Sub OF_to_MSAOF(of As OPENFILENAME, msaof As MSA_OpenfileName)
msaof.StrFullPathReturned = left$(of.lpstrFile, InStr(of.lpstrFile, CHR$(0)))
msaof.StrFileNameReturned = of.lpstrFileTitle
msaof.intFileOffset = of.nFileOffset
msaof.intFileExtension = of.nFileExtension
End Sub
Private Sub MSAOF_to_OF(msaof As MSA_OpenfileName, of As OPENFILENAME)
Dim strFile As String * 512
of.hwndOwner = Application.hWndAccessApp
of.hInstance = 0
of.lpstrCustomFilter = 0
of.nMaxCustrFilter = 0
of.lpfnHook = 0
of.lpTemplatename = 0
of.lCustrData = 0
If msaof.strFilter = „“ Then
of.lpstrFilter = MSA_CreateFilterString(ALLFILES)
Else
of.lpstrFilter = msaof.strFilter
End If
of.nFilterIndex = msaof.lngFilterIndex
of.lpstrFile = msaof.StrInitialFile & String$(512 - Len(msaof.StrInitialFile), 0)
of.nMaxFile = 511
of.lpstrFileTitle = String$(512, 0)
of.nMaxFileTitle = 511
of.lpstrTitle = msaof.strDialogTitle
of.lpstrInitialDir = msaof.strINitialDir
of.lpstrDefExt = msaof.strDefaultExtension
of.Flags = msaof.lngFlags
of.lStructSize = Len(of)
End Sub
Function MSA_CreateFilterString(ParamArray varFilt() As Variant) As String
’ Erstellt aus den übergebenen Argumenten eine Filterzeichenfolge
’ Gibt „“ zurück, wenn keine Argumente übergeben werden
’ Erwartet eine gerade Anzahl von Argumenten (Filtername, Erweiterung).
’ Fügt *.* hinzu, wenn eine ungerade Anzahl übergeben wird.
Dim strFilter As String
Dim intRet As Integer
Dim intNum As Integer
intNum = UBound(varFilt)
If (intNum -1) Then
For intRet = 0 To intNum
’
strFilter = strFilter & varFilt(intRet) & CHR$(0)
Next
If intNum Mod 2 = 0 Then
’
strFilter = strFilter & „*.*“ & CHR$(0)
End If
’
strFilter = strFilter & CHR$(0)
Else
strFilter = „“
End If
MSA_CreateFilterString = strFilter
End Function
Um Word mit der Datei aufzurufen benutze folgende Funktion:
Function WordMitDatei(Dateiname As String)
'Aufruf von Winword und Öffnen der angegebenen Datei.
'Code für Access 95, 97, 2000 mit Word 97 und 2000
Dim objWrdApp As Object
Dim objWrdDoc As Object
On Error Resume Next
Set objWrdApp = GetObject(, „Word.Application“)
If Err 0 Then
'Word war noch nicht gestartet also wird eine neue Instanz erzeugt:
Set objWrdApp = CreateObject(„Word.application“)
End If
On Error GoTo ErrTrapWordMitDatei
Set objWrdDoc = objWrdApp.Documents.Add(Dateiname)
objWrdApp.Visible = True
objWrdApp.Activate
ProzExitWordMitDatei:
Exit Function
ErrTrapWordMitDatei:
Beep
Select Case Err
Case 5151
MsgBox „Die von Ihnen angegebene Datei '“ & Dateiname & „’ existiert nicht oder befindet sich nicht in dem angegebenen Verzeichnis.“ & vbCrLf & „Bitte überprüfen Sie die Pfadangaben und / oder den Dateinamen!“, 16
Resume Next
Case Else: MsgBox „Fehler Nr.: '“ & Err & „’: '“ & Error(Err) & "’ beim Aufruf der Funktion ‚WordMitDatei‘ aufgetreten. ", 16, „Fehler!“
End Select
Set objWrdDoc = Nothing
Set objWrdApp = Nothing
Resume ProzExitWordMitDatei
End Function
have fun + nice weekend!
Alex
[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]
Tja, warum einfach, wenn’s auch kompliziert geht? ;=)
Function OpenWordDoc(Optional MyPath = "C:\Temp\MyWord.Doc")
Dim Obj As Object, Doc As Object
On Error Resume Next
Set Obj = GetObject(, "Word.Application")
If Err = 429 Then
Set Obj = CreateObject("Word.Application")
ElseIf Err 0 Then
MsgBox "Fehler: " & Err.Description
End If
Err.Clear
Obj.Documents.Open MyPath
If Err 0 Then
Set Doc = Obj.Documents.Add
Doc.SaveAs MyPath
End If
Err.Clear
Obj.Visible = True
End Function
Reinhard
Tja, warum einfach, wenn’s auch
kompliziert geht? ;=)
Jo! Ist aber auch nur der Word-Call! Und was macht Deine Funktion, wenn das Verzeichnis nicht vorhanden ist? Und ob ich ein neues Doc ohne Nachfrage will, wenn das gerufene Doc nicht da ist??? =:wink:)
Aber ansonsten, Kompliment, auch wenn Deine Antworten häufig etwas bissig und kurz sind, so hast Du doch richtig was drauf!
Grüße
Alex