AW: Serienbrief Filtern Lösung gefunden
17.02.2016 07:26:33
Peter
Hallo Michael,
besten Dank für Deine Hilfe. Ich habe zwischenzeitlich die Lösung gefunden.
Die nachstehenden Makros wählen die richtige Tabelle aus und setzen über ActiveDocument.MailMerge.DataSource.QueryString = ... die richtige Filterung.
Sub AutoOpen()
Call Makro_Empfänger_auswählen
End Sub
Sub Makro_Sendungen_auswählen()
SendKeys "%{G}"
SendKeys "%"
End Sub
Sub Makro_Empfänger_auswählen()
Dim FSO As Object
Dim strPfad As String
Dim x As Integer
Dim strGef As Object
Dim Test As String
Dim MyPfad As String
MyPfad = ActiveDocument.Path '& "\" & IniName
' MsgBox (MyPfad)
On Error GoTo DispFehler
Application.DisplayAlerts = False
Application.ScreenUpdating = False
''strPfad = "C:\Users\Peter\Desktop\Kopierkosten\Kopierkosten laufend\"
'ActiveSheet.UsedRange.Clear
'strPfad = "C:\Users\Peter\Desktop\Kopierkosten\Kopierkosten laufend\"
strPfad = MyPfad & "\" & "Kopierkosten laufend" & "\"
Set FSO = CreateObject("Scripting.FilesystemObject")
For Each strGef In FSO.getfolder(strPfad).Files
Select Case LCase(FSO.getextensionname(strGef))
Case "xls", "xla", "xlsm", "xlsx"
x = x + 1
' ActiveSheet.Hyperlinks.Add Anchor:=Cells(x, 1), Address:= _
' strGef, TextToDisplay:=strGef.Name
'Debug.Print strGef.Name
'Test = strPath & "\" & strGef
'MsgBox (strGef)
Test = strGef
End Select
Next
Application.ScreenUpdating = True
ActiveDocument.MailMerge.OpenDataSource Name:=Test _
, ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
Format:=wdOpenFormatAuto, Connection:= _
"Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=Test;Mode=Read;Extended _
Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path" _
, SQLStatement:="SELECT * FROM `Gesamtabrechnung$`", SQLStatement1:="", _
SubType:=wdMergeSubTypeAccess
ActiveDocument.MailMerge.DataSource.QueryString = _
"SELECT * FROM `Gesamtabrechnung$` WHERE `Code` > 0 And `Ges#Anzahl` > 0 "
DispFehler:
Application.DisplayAlerts = True
Call Makro_Sendungen_auswählen
End Sub
Wünsche noch einen schönen Tag.
Gruss Peter