Hmm also es wurde mir in einem anderen Form schneller geholfen (soll keine Wertung sein, ich schätze das Forum hier sehr auch wenn ich mehr lese als schreibe)
Falls nun aber wer etwas ähnliches machen möchte, oder mal danach sucht, poste ich hier mal den Code:
dim oAccess
dim oCheck
dim sFolder
dim oFSO
dim sNewDB
const WORKDB = "C:\work.mdb"
const OLDDB = "c:\old.mdb"
const NEWFOLDER = "Z:\ZielLaufwerk+Folde"
const DBNAME = "speichername.mdb"
sFolder = NEWFOLDER & GetDateFolder
sNewDB = sFolder & "\" & DBNAME
set oFSO = CreateObject("Scripting.FileSystemObject")
if not oFSO.FolderExists(sFolder) then
oFSO.CreateFolder sFolder
end if
if oFSO.FileExists(sNewDB) then
oFSO.DeleteFile(sNewDB)
end if
' set oCheck = GetObject(,"Access.Application")
'
' if not oCheck is nothing then
' if oCheck.
' end if
set oAccess = CreateObject("Access.Application")
oAccess.OpenCurrentDatabase WORKDB
oAccess.DBEngine.CompactDatabase OLDDB , sNewDB
oAccess.CloseCurrentDatabase
oAccess.Quit 2
set oAccess = Nothing
set oFSO = Nothing
msgbox "Fertig"
function GetDateFolder
GetDateFolder = cstr(year(date)) & "_" & M2D(cstr(month(date))) & "_" & M2D(cstr(day(date)))
end function
function M2D(n)
if len(n) = 1 then
n = "0" & n
end if
M2D = n
end function