- Konuda belirttiğim kodu konuyu açtıktan sonra örnek dosyaları incelerken gördüm eklediğim uygulamada yok. Kendi uygulamam içinde denedim ana form üzerindeki alanı yer imi olmadan word dosyasına aktarmakta. Fakat alt formdaki alanı aktaramadım.
- Kodu çalıştırdığımda sorguyu açmakta ve sonrasında yeni bir word dosyası açarak alanı sorgudan değil formdan alarak aktarmakta.
- Yabancı bir siteden bulduğum kod ise sorgu üzerinden dosya konumu belirtilen word dosyasına tablo oluşturarak sorgudaki bilgileri bu tabloya aktarmakta. (benim yapmak istediğim tam da bu) Fakat kendi uylamama eklediğimde runtime eror 3061 hatasını vermekte
KOD:
Kod:
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim i As Integer
Dim intRecords As Integer
Dim intColumns As Integer
strSQL = "qryTest"
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL, dbOpenSnapshot)
If rs.EOF = True Then
MsgBox "No records were retrieved. Cannot continue.", vbCritical, "Request Aborted"
rs.Close
Set db = Nothing
Exit Sub
End If
'lets get some counts
rs.MoveLast
intRecords = 0
intRecords = rs.RecordCount
Debug.Print "rs.RecordCount = " & intRecords
'Name the Range for the data added
intRecords = intRecords + 1 'add one row for the header names
'lets see how many columns we have
intColumns = 0
intColumns = rs.Fields.Count
'*************************************
Dim myWordApp As Word.Application
Dim docNew As Word.Document
Dim docTable As Word.Table
Set myWordApp = CreateObject("Word.Application")
myWordApp.Visible = True
Set docNew = myWordApp.Documents.Open("C:\Test\WordDocFolder\TestMailMerge.docx")
'Create a table that has the correct number of cells
docNew.Tables.Add Range:=docNew.Range(Start:=0, End:=0), NumRows:=intRecords, NumColumns:=intColumns
Set docTable = docNew.Tables(1)
'Get some header names in the first Row
For i = 1 To rs.Fields.Count
docTable.Cell(1, i).Range.Text = rs.Fields(i - 1).Name
Next i
rs.MoveLast
While rs.BOF = False
'Populate the last row
For i = 1 To rs.Fields.Count
If Not IsNull(rs.Fields(i - 1).Value) Then
docTable.Cell(intRecords, i).Range.Text = rs.Fields(i - 1).Value
End If
Next i
Debug.Print intRecords
intRecords = intRecords - 1
rs.MovePrevious
Wend
docNew.Save
docNew.Close
myWordApp.Quit
Set docNew = Nothing
Set myWordApp = Nothing