Check alle échte Black Friday-deals Ook zo moe van nepaanbiedingen? Wij laten alleen échte deals zien
Toon posts:

VB + Access bestandslocatie

Pagina: 1
Acties:
  • 38 views sinds 30-01-2008

Verwijderd

Topicstarter
Hallo,

In Access heb ik een knop aangemaakt met daaronder vb code om een word document te genereren in een door mij opgegeven directory. De code werkt alleen het document wordt niet gemaakt in de de door mij opgegeven lokatie in het script maar in de "standaard office documenten" directory. De directory dus die je in Word en register in kan stellen om alle standaard documenten gemaakt in office op te slaan. Weet iemand waarom de lokatie uit mijn script niet gebruikt wordt? Ik hoop dat ik mijn probleem duidelijk omschreven heb, ik ben nog niet zolang bezig met vb. Ik wil dus graag het document laten saven in strDocsPath = "C:\data\"

Dim stAppName$, stPathName$
Start = Me!Order_ID
stAppName = "C:\Program Files\Microsoft Office\OFFICE11\winword.exe "
stPathName = "C:\data\"
stFileName = Start & "*" & ".doc"

Set fs = Application.FileSearch
With fs
.LookIn = stPathName
.FileName = stFileName
.SearchSubFolders = True
If .Execute > 0 Then
strNotePadFile = .FoundFiles(.FoundFiles.Count)
Call Shell(stAppName & strNotePadFile, 1)
Else
MsgBox "Er is geen BAS gevonden er wordt een nieuwe aangemaakt."
cbotest.Value = True


Dim docs As Word.Documents
Dim strWordTemplate As String
Dim strDocsPath As String
Dim strTemplatePath As String
Dim prps As Object
Dim strShortDate As String
Dim strLongDate As String
Dim strTest As String
Dim strAddress As String
Dim strCountry As String
Dim strSaveName As String
Dim strTestFile As String
Dim intSaveNameFail As Boolean
Dim i As Integer
Dim strSaveNamePath As String
Dim oApp As Object


'Set global Word application variable; if Word is not running,
'the error handler defaults to CreateObject


Set oApp = CreateObject("Word.Application")
oApp.Visible = True

Set pappWord = GetObject(, "Word.Application")

strLongDate = Format(Date, "mmmm d, yyyy")
strShortDate = Format(Date, "m-d-yyyy")
strSaveName = Me![Order_ID]
strSaveName = strSaveName & ".doc"
strDocsPath = "C:\data\"
strTemplatePath = "C:\templates\"
strWordTemplate = strTemplatePath & "\" & "bas.dot"

'Check for existence of template in template folder,
'and exit if not found
strTestFile = Nz(Dir(strWordTemplate))
Debug.Print "Test file: " & strTestFile
If strTestFile = "" Then
MsgBox strWordTemplate & " Template niet gevonden, kan geen bestelaanvraag maken"
GoTo ErrorHandlerExit
End If

'Check for existence of previously saved letter in documents folder,
'and append an incremented number to save name if found
i = 2
intSaveNameFail = True
Do While intSaveNameFail
strSaveNamePath = strDocsPath & strSaveName
Debug.Print "Proposed save name and path: " _
& vbCrLf & strSaveNamePath
strTestFile = Nz(Dir(strSaveNamePath))
Debug.Print "Test file: " & strTestFile
If strTestFile = strSaveName Then
Debug.Print "Bestelaanvraag bestaal al " & strSaveName

'Create new save name with incremented number
intSaveNameFail = True
strSaveName = Me![Order_ID]
strSaveName = strSaveName & ".doc"
strSaveNamePath = strDocsPath & strSaveName
Debug.Print "New save name and path: " _
& vbCrLf & strSaveNamePath
i = i + 1
Else
Debug.Print "Save name not used: " & strSaveName
intSaveNameFail = False
End If
Loop

Set docs = pappWord.Documents
docs.Add strWordTemplate

Set prps = pappWord.ActiveDocument.CustomDocumentProperties
prps.Item("Datum_aanvraag").Value = strLongDate
prps.Item("Naam_aanvrager").Value = Nz(Me![Naam_aanvrager])
prps.Item("Order_ID").Value = Nz(Me![Order_ID])


With pappWord
.Visible = True
.Selection.WholeStory
.Selection.Fields.Update
Debug.Print "Going to save as " & strSaveName
.ActiveDocument.SaveAs strSaveName
.Activate
.Selection.EndKey Unit:=wdStory
End With

ErrorHandlerExit:
Set pappWord = Nothing
Exit Sub

ErrorHandler:
'Word is not running; open Word with CreateObject
If Err.Number = 429 Then
Set pappWord = CreateObject("Word.Application")
Resume Next
Else
MsgBox "Error No: " & Err.Number & "; Description: "
Resume ErrorHandlerExit
End If

End If

End With

  • whoami
  • Registratie: December 2000
  • Nu online
Heb je de code zelf al eens gedebugged / stap voor stap doorlopen ?
Je post hier nu een lap code zonder eigenlijk aan te geven of je uberhaupt zelf al eens geprobeerd hebt de boel te debuggen. Dit komt bij mij nu wel over als een 'hier m'n code, los het ff voor me op' topic, en dergelijke dingen wensen we hier niet eigenlijk.
Vandaar dat ik het topic dicht doe. Misschien kan je even de quickstart doornemen.

https://fgheysels.github.io/


Dit topic is gesloten.