Форумы HiProg.com - MS ACCESS, VBA, VB

ник: palarm
Но лучше сделать запрос с полями по именам закладок. Тогда можно автоматизировать это дело. Например так (это часть секретного кода из LibFrm.mde формы subFrmReport, которая выводит отчеты )

Function funOutputWord(strWord As String, frm As Form) As Boolean On Error GoTo Err_ Dim rst As DAO.Recordset Dim app As Word.Application Dim DlgUser As Integer Dim strPathDot As String, strPathWord As String, s As String Dim ctl As Control Dim i As Long     strPathDot = DLookup("ParamValue", "tGlobalPathFolder", "[ParamName] = '" & "PathWordDot" & "'") & "\" & _                         strWordDotName & "\" & Me.rptTextName & ".dot"     strPathWord = DLookup("ParamValue", "tGlobalPathFolder", "[ParamName] = '" & "PathWordDoc" & "'")     If IsFileName(strPathDot) = False Then Exit Function     If Dir(strPathWord & "\" & strWordDotName & "\" & strWord) <> "" Then         DlgUser = MsgBox("Документ с таким именем ранее уже был создан. Заменить его?", vbYesNo, "admin")         If DlgUser = vbNo Then             Set app = CreateObject("Word.Application")             With app                 .Visible = True                 .Documents.Open strPathWord & "\" & strWordDotName & "\" & strWord             End With             Set app = Nothing         Else             GoTo nn         End If     Else nn:         funCreateFolder (strPathWord & "\" & strWordDotName)         Set app = New Word.Application         app.Visible = True         app.Documents.Add strPathDot         With app.ActiveDocument             Set rst = CurrentDb.OpenRecordset("SELECT " & Me![rptName] & ".* FROM " & Me![rptName] & _                                             " IN '" & CurrentProject.Path & "\" & strBaseName & "'")             On Error Resume Next             For i = 1 To rst.Fields.Count                 .Bookmarks.Item(rst.Fields(i).Name).Range.Text = rst.Fields(i)             Next i             rst.Close             .SaveAs strPathWord & "\" & strWordDotName & "\" & strWord         End With         Set app = Nothing         funOutputWord = True     End If Exit_:     Exit Function Err_:     MsgBox Err.Description     funOutputWord = False     Err.Clear     app.Quit     Resume Exit_ End Function