Dim SourceFileName As String
Dim DestinFileName As String
Dim i As Integer 'Counter Bijlagen velden in tabel Bijlagen (max 26)
Dim FldName As String
Dim VldNr As String
Dim VldName As String
Dim Fld As String
Dim strSQL As String
Dim BijlagePad1 As String
Dim BijlagePad As String
Dim IDnr As Integer
'Bepaal IndexNr ID 'Bepaling index ID
IndexNr = "Bijlagen_ID = " & Me.Bijlagen_ID 'Current ID werkorder (Wrknr)" Bijlage_ID = 19
Lengte = Len(IndexNr) '16
IDnr = Lengte - 14
IDnr = Right(IndexNr, IDnr) 'Resultaat: Indexnumer ID van het huidige formulier
CurrDir = "D:\Bijlagen_email_db\Vervangen\" 'Save the current folder
NewDir = "D:\Bijlagen_email_db\Vervangen\T schijf\" 'Verander de map naar de nieuwe map AANPASSEN T schijf
strFileSpec = CurrDir & "*.*"
sFile = Dir(strFileSpec) 'Haal de eerste file in de map
VldNr = Right("Bijlage1", 1) 'Bepaal nummer van bijlage
VldName = Left("Bijlage1", 7) 'Eerste deel van de naam Bijlage (Bijlage1)
VldNr = VldNr - 1 'Zet volg nummer op 0
FldName = VldName & VldNr 'Maak Bijlage0
Do While Len(Nz(sFile)) > 0 'Rename until no more files
OldName = sFile 'CurrDir &
SourceFileName = CurrDir & sFile 'Map met bestand "Vervangen"
DestinFileName = NewDir & sFile 'Map T schijf en bestand
'Opslag in tabel
For i = 1 To 26 'Voor 26 bijlagen wordt inhoud veld BijlagenX onderzocht en bij Null de Bijlage opgeslagen
VldNr = VldNr + 1
FldName = VldName & VldNr 'Volgende BijlageX samenstellen
If Not IsNull(DLookup(FldName, "[Bijlagen]", "[Bijlagen_ID]=" & Me.[Bijlagen_ID])) Then 'Is het veld BijlageX reeds voorzien met een bijlage?
FldName = FldName 'Fake instructie
Else
'Veld is Null
DoCmd.SetWarnings False
'strSQL = "UPDATE Bijlagen set Bijlagen." & FldName & " = """ & OldName & """ WHERE Bijlagen.Bijlagen_ID = " & Me.Bijlagen_ID 'Voeg Bijlage in de tabel toe, TIJDELIJK vervallen voor test
strSQL = "UPDATE Bijlagen set Bijlagen." & FldName & " = """ & OldName & """ & WHERE Bijlagen_ID ='" & [IDnr] & "'" 'Voeg Bijlage in de tabel toe, TEST met Indexnummer ID FOUTMELDING 3075
CurrentDb.Execute strSQL, dbFailOnError
DoCmd.SetWarnings True
Me.Form.Requery 'Refresh form Bijlagen, bijlagenamen worden zichtbaar
'DoCmd.SetWarnings False 'Tijdelijk vervallen voor test. Tweede coderegel. Inpassen in eerste coderegel!!!!!!!!!!!!!!!!
'strSQL = "UPDATE Bijlagen set Bijlagen." & BijlagePad1& " = """ & NewDir & """ WHERE Bijlagen.Bijlagen_ID = " & Me.Bijlagen_ID 'Voeg Bijlage toe, TIJDELIJK vervallen
'CurrentDb.Execute strSQL, dbFailOnError
'DoCmd.SetWarnings True
'If Me.BijlagePad1 & "" = "" Then
'Me.BijlagePad1 = NewDir 'Tijdelik vervallen voor test. Gaan combineren met eerste code regel strSQL !!!!!!!!!!!!!!!
'DoCmd.RunCommand acCmdSaveRecord 'Save bijlage in record
'End If
i = 26 'Bijlage is opgeslagen, volgende bijlage ophalen
On Error Resume Next 'Voor als het bestand al bestaat en dus meerdere malen wordt opgeslagen vanuit dezelfde mail
Name SourceFileName As DestinFileName 'Verplaatst de file naar de volgende map T schijf
On Error GoTo 0
End If
Next i
sFile = Dir 'Get next file to rename
Loop
On Error Resume Next
If CurrDir <> "" Then
Kill CurrDir & "*.*" 'Wist alle voorgande bestanden uit de map [Folder]
On Error GoTo 0
End If
Set oOutlook = Nothing
'Set ObjApp = Nothing 'Geeft ook een FOUTMELDING dat het obj (Outlook is eerder gedefinieerd) niet bestaat !!!!!!!!!!!!!!!! Tijdelijk uitgeschakeld.
Set currentExplorer = Nothing '
Set obj = Nothing
.
