DataSource - Brevfletning
Jeg har problemer med denne del af den nedenstående kode!objWord.MailMerge.OpenDataSource Name:="C:\Produktion\Projekter\Sikkerhedslev.mdb", LinkToSource:=True, Connection:="QUERY Ark2B", SQLStatement:="SELECT * FROM Ark2B"
Koden virker fint, indtil jeg lægger databasen op på en server og retter drevet til enten det drev bogstav jeg har i min profil eller til ”\\server\mappe\”
Problemet er at lige så snart jeg har lagt den på serveren og kører koden så bliver databasen åbnet x antal gange og fejler brevfeltningen, selv om jeg allerede har den åben.
Kører jeg den fra C-drevet er der ingen problemer, databasen bliver ikke åbnet x antal gange.
C-drevet er dog ikke en mulighed jeg lige kan acceptere da det vil betyde at flere personer skal have en kopi af databasen og det er ikke nogen god løsning for mig.
Så er der nogen der hjælpe???
Public Sub run_del3()
Dim drev As String
Dim map1 As String
Dim fil1 As String
Dim dato As String
Dim qdf1 As QueryDef, qdf2 As QueryDef, qdf3 As QueryDef, qdf4 As QueryDef, qdf5 As QueryDef
Dim dbs As Database
Dim MyFile1
Dim objWord As Word.Document
Dim aWord As Word.Document
drev = "C:"
map1 = "\Produktion\Projekter\Kvalitet af reklamationer\Sikkerhedslev\" & prod & "\"
dato = Format(Now, "yyyy")
fil1 = "Sikker-" & prod & "_" & grp & " uge " & ugen & "-" & dato & ".doc"
MyFile1 = drev & map1 & fil1
RSQL1 = "SELECT DISTINCT Max(ABO880.Abonnr) AS MaksOfAbonnr, Max(ABO880.ReklDato) AS MaksOfReklDato, ABO880.Produktnr, " & _
"ABO880.Gruppenr, ABO880.Jobnr FROM Udtræk2 INNER JOIN ABO880 ON Udtræk2.Abonnr = ABO880.Abonnr " & _
"GROUP BY ABO880.Produktnr, ABO880.Gruppenr, ABO880.Jobnr " & _
"HAVING (((Max(ABO880.Abonnr)) In (SELECT Abonnr FROM ABO880 As Tmp GROUP BY Abonnr HAVING Count(*)>1 )))" & _
"ORDER BY Max(ABO880.Abonnr), Max(ABO880.ReklDato);"
RSQL2 = "SELECT Dub2.MaksOfAbonnr, Dub2.MaksOfReklDato, Dub2.Produktnr, Dub2.Gruppenr, Dub2.Jobnr, ABO880.ReklKode, " & _
"ABO880.ReklTekst, ABO880.Påtale, ABO880.Anul, ABO880.Gadenavn, ABO880.Husnr, ABO880.Opgang, ABO880.Etage, " & _
"ABO880.Side, ABO880.Postnr, ABO880.Efternavn, ABO880.Fornavn, ABO880.COnavn, ABO880.Stedbetegnelse, ABO880.ReklOpret, " & _
"ABO880.Forklar, ABO880.Udgavenr " & _
"FROM ABO880 INNER JOIN Dub2 ON (ABO880.ReklDato = Dub2.MaksOfReklDato) AND (ABO880.Abonnr = Dub2.MaksOfAbonnr) AND (ABO880.Produktnr = Dub2.Produktnr) AND (ABO880.Jobnr = Dub2.Jobnr) AND (ABO880.Gruppenr = Dub2.Gruppenr) " & _
"WHERE (((Dub2.Produktnr) = " & soeg & "));"
RSQL3 = "SELECT ABO880.ReklDato, ABO880.ReklKode, ABO880.ReklTekst, ABO880.Påtale, ABO880.Anul, ABO880.Produktnr, " & _
"ABO880.Abonnr, ABO880.Gadenavn, ABO880.Husnr, ABO880.Opgang, ABO880.Etage, ABO880.Side, ABO880.Postnr, " & _
"ABO880.Efternavn, ABO880.Fornavn, ABO880.COnavn, ABO880.Stedbetegnelse, ABO880.ReklOpret, ABO880.Gruppenr, " & _
"ABO880.Jobnr, ABO880.Forklar, ABO880.Udgavenr FROM ABO880 " & _
"WHERE (((ABO880.ReklDato)=Formularer!Hovedmenu!Dato1) AND ((ABO880.Produktnr) = " & soeg & "));"
RSQL4 = "SELECT ABO880.Abonnr, ABO880.Gruppenr, ABO880.Gadenavn & ' ' & ABO880.Husnr & ' ' & ABO880.Opgang & ' ' & ABO880.Etage & ' ' & ABO880.Side As Gade, " & _
"IIF([ABO880]![Fornavn]>'',[ABO880]![Fornavn] & ' ' & [ABO880]![Efternavn],[ABO880]![Efternavn]) As Navn, ABO880.COnavn, ABO880.Stedbetegnelse, " & _
"Prodnr.Varenavn, ABO880.Postnr & ' ' & Postnr.Bynavn As PostnrBy " & _
"FROM ((ABO880 INNER JOIN Dub2 ON (ABO880.ReklDato = Dub2.MaksOfReklDato) AND (ABO880.Abonnr = Dub2.MaksOfAbonnr) AND (ABO880.Produktnr = Dub2.Produktnr) AND (ABO880.Jobnr = Dub2.Jobnr) AND (ABO880.Gruppenr = Dub2.Gruppenr)) INNER JOIN postnr ON ABO880.Postnr = postnr.Postnr) INNER JOIN Prodnr ON ABO880.Produktnr = Prodnr.Varenummer " & _
"WHERE (((Dub2.Produktnr) = " & soeg & " AND (Dub2.Gruppenr) = " & grp & "));"
RSQL5 = "SELECT ARK2A.Gruppenr, ARK2A.Abonnr, ARK2A.Gade, ARK2A.Navn, ARK2A.COnavn, ARK2A.Stedbetegnelse, ARK2A.Varenavn, ARK2A.PostnrBy FROM ARK2A " & _
"GROUP BY ARK2A.Gruppenr, ARK2A.Abonnr, ARK2A.Gade, ARK2A.Navn, ARK2A.COnavn, ARK2A.Stedbetegnelse, ARK2A.Varenavn, ARK2A.PostnrBy;"
Set dbs = CurrentDb
Set qdf3 = dbs.CreateQueryDef("Udtræk2", RSQL3)
Set qdf1 = dbs.CreateQueryDef("Dub2", RSQL1)
Set qdf2 = dbs.CreateQueryDef("Ark2", RSQL2)
Set qdf4 = dbs.CreateQueryDef("Ark2A", RSQL4)
Set qdf5 = dbs.CreateQueryDef("Ark2B", RSQL5)
If dir(MyFile1) = "" Then
If DCount("*", "Ark2B") = 0 Then
'nothing
Else
Select Case grp
Case 16, 74, 73, 76, 29, 80, 89, 90, 93, 94, 91, 92, 95, 96, 118, 119, 120, 121, 122, 124, 102, 103, 105, 106, 107, 108, 104
If soeg = 420 Then
Set objWord = GetObject("C:\Produktion\Projekter\Kvalitet af reklamationer\Sikkerhedslev-vest-ING.dot", "Word.Document")
Else
Set objWord = GetObject("C:\Produktion\Projekter\Kvalitet af reklamationer\Sikkerhedslev-vest.dot", "Word.Document")
End If
Case Else
If soeg = 420 Then
Set objWord = GetObject("C:\Produktion\Projekter\Kvalitet af reklamationer\Sikkerhedslev-øst-ING.dot", "Word.Document")
Else
Set objWord = GetObject("C:\Produktion\Projekter\Kvalitet af reklamationer\Sikkerhedslev-øst.dot", "Word.Document")
End If
End Select
' Make Word visible.
objWord.Application.Visible = True
' Set the mail merge data source as the Northwind database.
objWord.MailMerge.OpenDataSource Name:="C:\Produktion\Projekter\Sikkerhedslev.mdb", LinkToSource:=True, Connection:="QUERY Ark2B", SQLStatement:="SELECT * FROM Ark2B"
' Execute the mail merge.
objWord.MailMerge.Execute
objWord.Close False
Word.ActiveDocument.SaveAs MyFile1
Word.ActiveDocument.Close False
End If
Else
MsgBox "Filen " & drev & map1 & fil1 & " eksistere!!!"
End If
dbs.QueryDefs.Delete qdf1.Name
dbs.QueryDefs.Delete qdf2.Name
dbs.QueryDefs.Delete qdf3.Name
dbs.QueryDefs.Delete qdf4.Name
dbs.QueryDefs.Delete qdf5.Name
