ozanakkaya yazdı:Kod içerisinde strTemplateLocation ibaresi var ancak bununla ilgili herhangi bir tanım yok.
Örnek uygulamanızı ekleyerek Access soruları bölümüne yeni konu açınız. Bu bölüm Cevaplanmış Soru bölümü.
strTemplateLocation yukarıda tanımlı hocam uygulama aynı uygulama olduğu için bu konuyu devam ettirdim.
Kod:
Sub WordHazirla(h_evrak)
Dim masterdosya As String
Dim e_no As String
Dim haz_evrak As String
haz_evrak = h_evrak
Dim dataadres As Variant
Dim veri As String
Dim veriform As String
Dim dosyasorgusu As Variant, kriter As String
kriter = "para_birimi='" & [Para Birimi] & "' And evrakadi='" & haz_evrak & "'"
dosyasorgusu = DLookup("masteradresi", "tbl_evraklistesi", kriter)
If IsNull(dosyasorgusu) Then
MsgBox "Master dosya tanımlanamadı.", vbApplicationModal, "Piu Muhasebe Form Yönetim Sistemi Uyarı"
Exit Sub
Else
masterdosya = dosyasorgusu
e_no = DLookup("e_no", "tbl_evraklistesi", kriter)
MsgBox masterdosya, vbCritical, Uyarı
End If
If masterdosya = "" Then
MsgBox "Evrak hazırlanamıyor."
Else
Dim WordApp As Word.Application
Dim strTemplateLocation As String
Dim newPicture
Dim Path As String
Path = CurrentProject.Path & "/Ödeme Takibi Uygulaması/Arşiv/" & [İş] & "/" & [Kimlik] & " - " & [Firma] & "/"
strTemplateLocation = masterdosya
On Error Resume Next
Set WordApp = GetObject(Path, "Word.Application")
If Err.Number <> 0 Then
Set WordApp = CreateObject("Word.Application")
End If
WordApp.Visible = True
WordApp.WindowState = wdWindowStateMaximize
WordApp.Documents.Add Template:=strTemplateLocation, NewTemplate:=False
With WordApp.Selection
Dim objRecordset As ADODB.Recordset
Set objRecordset = New ADODB.Recordset
Dim i As Integer
Dim value As Variant
'initated recordset obejct
objRecordset.ActiveConnection = CurrentProject.Connection
objRecordset.Open ("Select ea_no, be_no, uygulama, alan_adres, alan_adi, veri_adres" & _
" From tbl_evrakhazirlaalanlistesi" & _
" Where be_no =" & e_no)
'find the target record
While objRecordset.EOF = False
'check for match
dataadres = objRecordset.Fields(3).value
veri = objRecordset.Fields(5).value
'veriform = Me(veri).value ' Veritabanından çekilen veriyi formda buluyorum.
If IsNull(Me(veri).value) Then
veriform = " "
Else
veriform = Me(veri).value ' Veritabanından çekilen veriyi formda buluyorum.
End If
If IsNull(veriform) Then
.GoTo what:=wdGoToBookmark, Name:=dataadres
.TypeText " "
MsgBox dataadres, vbCritical
Else
.GoTo what:=wdGoToBookmark, Name:=dataadres
.TypeText veriform
End If
objRecordset.MoveNext
Wend
Dim Path4 As String
[size=2][font=Monaco, Consolas, Courier, monospace] Path4 = CurrentProject.Path & "/Ödeme Ta[/font][/size][size=2][font=Monaco, Consolas, Courier, monospace]kibi Uygulaması/Arşiv/" & [İş] & "/" & [Kimlik] & " - " & [Firma] & "/"[/font][/size]
[size=2][font=Monaco, Consolas, Courier, monospace] [/font][/size]
[size=2][font=Monaco, Consolas, Courier, monospace] Dim FileN As String[/font][/size]
[size=2][font=Monaco, Consolas, Courier, monospace] Dim both As String[/font][/size]
[size=2][font=Monaco, Consolas, Courier, monospace] FileN = h_evrak & "-" & [Fatura No] & ".doc"[/font][/size]
[size=2][font=Monaco, Consolas, Courier, monospace] both = Path4 & FileN[/font][/size]
[size=2][font=Monaco, Consolas, Courier, monospace] [/font][/size]
WordApp.ActiveDocument.SaveAs (both)
Set WordApp = Nothing
DoEvents
End With
Exit Sub
ErrHandler:
Set WordApp = Nothing
MsgBox "error"
End If
End Sub