Goedenavond,
Ik hoop dat de Access experts mij kunnen helpen.
De code hieronder maakt een Excel bestand dat wordt opgeslagen op de PC/Laptop van de gebruiker.
Het gaat prima zolang de gebruiker er maar voor zorgt dat er geen Excel met dezelfde naam open staat.
Als het bestand nog open staat dan krijg ik Error 70, het bestand kan dan niet meer verwijderd worden (kenmerk - alleen lezen)
Nu zou ik graag een code willen toevoegen die controleert of een bestand met dezelfde naam open staat. Dat bestand moet dan gesloten worden.
Excel mag niet gesloten worden omdat de gebruiker(s) vaak nog andere Excel bestanden open hebben staan.
Alvast bedankt voor de hulp.
Gr. Jan
Ik hoop dat de Access experts mij kunnen helpen.
De code hieronder maakt een Excel bestand dat wordt opgeslagen op de PC/Laptop van de gebruiker.
Het gaat prima zolang de gebruiker er maar voor zorgt dat er geen Excel met dezelfde naam open staat.
Als het bestand nog open staat dan krijg ik Error 70, het bestand kan dan niet meer verwijderd worden (kenmerk - alleen lezen)
Nu zou ik graag een code willen toevoegen die controleert of een bestand met dezelfde naam open staat. Dat bestand moet dan gesloten worden.
Excel mag niet gesloten worden omdat de gebruiker(s) vaak nog andere Excel bestanden open hebben staan.
Code:
strSQL = "SELECT tbl_selectie.Onderdeel, Left([Omschrijving],30) AS Omschr, Left([Extra_info],30) AS ExtraInfo, tbl_selectie.Magazijn, tbl_selectie.Locatie "
strSQL = strSQL & "FROM tbl_selectie;"
DoCmd.Hourglass (True)
Set rs1 = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
If rs1.RecordCount = 0 Then
MsgBox "Geen gegevens beschikbaar om te exporteren", vbInformation + vbOKOnly, "No data exported"
GoTo SubExit
End If
'Early Binding
Set xlApp = Excel.Application
xlApp.Visible = True
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
With xlSheet
.Name = "Kopieerlijst"
.Cells.Font.Name = "Arial"
.Cells.Font.Size = 11
.Cells.NumberFormat = "@"
'Set column widths
.Columns("A").ColumnWidth = 18
.Columns("B").ColumnWidth = 30
.Columns("C").ColumnWidth = 30
.Columns("D").ColumnWidth = 17
.Columns("E").ColumnWidth = 15
'Format colums
' .Columns("D").NumberFormat = "#,##0.00"
'build report heading
.Range("A1", "E1").Cells.Font.Bold = True
'build column headings
.Range("A1").Value = "Onderdeel"
.Range("B1").Value = "Omschrijving"
.Range("C1").Value = "Extra_info"
.Range("D1").Value = "Magazijn"
.Range("E1").Value = "Locatie"
'Format Column Headings
.Range("A1:E1").HorizontalAlignment = xlCenter
' .Range("A5:E5").Cells.Font.Bold = True
.Range("A1:E1").AutoFilter
'provide initial value to row counter
i = 2
'Loop through recordset and copy data from recordset to sheet
Do While Not rs1.EOF
.Range("A" & i).Value = Nz(rs1!Onderdeel, "")
.Range("B" & i).Value = Nz(rs1!Omschr, "")
.Range("C" & i).Value = Nz(rs1!ExtraInfo, "")
.Range("D" & i).Value = Nz(rs1!Magazijn, "")
.Range("E" & i).Value = Nz(rs1!Locatie, "")
i = i + 1
rs1.MoveNext
Loop
sMap = "C:\Access"
If Dir(sMap, vbDirectory) = "" Then MkDir sMap
sMap = sMap & "\" & "Excel"
If Dir(sMap, vbDirectory) = "" Then MkDir sMap
ChDir sMap
sMap = sMap & "\" & "Kopieerlijst" & ".xlsx"
If Len(Dir(sMap, vbDirectory)) > 0 Then Kill sMap
ActiveWorkbook.SaveAs FileName:=sMap, _
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End With
CurrentDb.Execute "DELETE tbl_selectie.* FROM tbl_selectie;", dbFailOnError
SubExit:
On Error Resume Next
DoCmd.Hourglass False
rs1.Close
Set rs1 = Nothing
Set dB = Nothing
Alvast bedankt voor de hulp.
Gr. Jan