H
HMB
Hi,
I have written some code that opend up a template
spreadsheet file and then sends data to the spreadsheet
for every consignment within a recordset.
I intend to send this spreadsheet/advice note out to the
relevant suppliers (This has not been added to the code
example below) for them to edit and return.
But here's the fun part. I need to lock certain cells so
the suppliers cannot edit certain data. Can this be done
from Access VBA, your help would be greatly appreciated.
Many Thanks,
Hayden
Sub ExportAdviceNotes()
Dim appXL As New Excel.Application
Dim wkbXL As New Excel.Workbook
Dim wsXL As Excel.Worksheet
Dim db As DAO.Database
Dim rstHeader As DAO.Recordset
Dim rstParts As DAO.Recordset
Dim strFile As String
Dim strCons As String
Dim strTemplate As String
Dim strDate As String
Dim strSQL As String
Set db = CurrentDb
Set rstHeader = db.OpenRecordset("Advice Note Header")
rstHeader.MoveFirst
'Prompt User to select the template
strTemplate = PromptFileName
Do Until rstHeader.EOF
strCons = rstHeader!ConsignmentNumber
strSQL = "SELECT [Advice Note Export].IPFPartNumber,
[Advice Note Export].Quantity FROM [Advice Note Export]
GROUP BY [Advice Note Export].ConsignmentNumber, [Advice
Note Export].IPFPartNumber, [Advice Note Export].Quantity
HAVING ((([Advice Note Export].ConsignmentNumber)='" &
strCons & "'));"
Set rstParts = db.OpenRecordset(strSQL)
'Debug.Print strSQL
Set wkbXL = appXL.Workbooks.Open(strTemplate)
With appXL
.Visible = False
ActiveSheet.Range("D2").Value = Trim(rstHeader!
ConsignmentNumber)
ActiveSheet.Range("B4").Value = Trim(rstHeader!
GSDBCode)
ActiveSheet.Range("B5").Value = Trim(rstHeader!
SuppName)
ActiveSheet.Range("B6").Value = Trim(rstHeader!
City)
ActiveSheet.Range("B7").Value = Trim(rstHeader!
Zip)
ActiveSheet.Range("B8").Value = Trim(rstHeader!
Country)
ActiveSheet.Range("B10").Value = Trim
(rstHeader!Telephone1)
ActiveSheet.Range("B11").Value = Trim
(rstHeader!Fax1)
ActiveSheet.Range("B12").Value = Trim
(rstHeader!Email1)
ActiveSheet.Range("H5").Value = rstHeader!
CollectionDate
ActiveSheet.Range("H6").Value = Format
(rstHeader!DeliveryDate, "dd/mm/yy")
ActiveSheet.Range("K4").Value = Trim(rstHeader!
DeliveryDock)
ActiveSheet.Range("G7").Value = Trim(rstHeader!
DeliveryWeek)
ActiveSheet.Range("A16").CopyFromRecordset
rstParts
strDate = Format(rstHeader!CollectionDate, "dd-
mm-yyyy")
strFile = "D:\My Documents\Advice Notes\" &
rstHeader!GSDBCode & "-" & strDate & "-" & rstHeader!
DeliveryDock & ".xls"
ActiveSheet.SaveAs strFile
Set rstParts = Nothing
rstHeader.MoveNext
End With
Loop
MsgBox "Completed"
wkbXL.Close
Set rstHeader = Nothing
Set appXL = Nothing
Set wkbXL = Nothing
Set wsXL = Nothing
Exit Sub
I have written some code that opend up a template
spreadsheet file and then sends data to the spreadsheet
for every consignment within a recordset.
I intend to send this spreadsheet/advice note out to the
relevant suppliers (This has not been added to the code
example below) for them to edit and return.
But here's the fun part. I need to lock certain cells so
the suppliers cannot edit certain data. Can this be done
from Access VBA, your help would be greatly appreciated.
Many Thanks,
Hayden
Sub ExportAdviceNotes()
Dim appXL As New Excel.Application
Dim wkbXL As New Excel.Workbook
Dim wsXL As Excel.Worksheet
Dim db As DAO.Database
Dim rstHeader As DAO.Recordset
Dim rstParts As DAO.Recordset
Dim strFile As String
Dim strCons As String
Dim strTemplate As String
Dim strDate As String
Dim strSQL As String
Set db = CurrentDb
Set rstHeader = db.OpenRecordset("Advice Note Header")
rstHeader.MoveFirst
'Prompt User to select the template
strTemplate = PromptFileName
Do Until rstHeader.EOF
strCons = rstHeader!ConsignmentNumber
strSQL = "SELECT [Advice Note Export].IPFPartNumber,
[Advice Note Export].Quantity FROM [Advice Note Export]
GROUP BY [Advice Note Export].ConsignmentNumber, [Advice
Note Export].IPFPartNumber, [Advice Note Export].Quantity
HAVING ((([Advice Note Export].ConsignmentNumber)='" &
strCons & "'));"
Set rstParts = db.OpenRecordset(strSQL)
'Debug.Print strSQL
Set wkbXL = appXL.Workbooks.Open(strTemplate)
With appXL
.Visible = False
ActiveSheet.Range("D2").Value = Trim(rstHeader!
ConsignmentNumber)
ActiveSheet.Range("B4").Value = Trim(rstHeader!
GSDBCode)
ActiveSheet.Range("B5").Value = Trim(rstHeader!
SuppName)
ActiveSheet.Range("B6").Value = Trim(rstHeader!
City)
ActiveSheet.Range("B7").Value = Trim(rstHeader!
Zip)
ActiveSheet.Range("B8").Value = Trim(rstHeader!
Country)
ActiveSheet.Range("B10").Value = Trim
(rstHeader!Telephone1)
ActiveSheet.Range("B11").Value = Trim
(rstHeader!Fax1)
ActiveSheet.Range("B12").Value = Trim
(rstHeader!Email1)
ActiveSheet.Range("H5").Value = rstHeader!
CollectionDate
ActiveSheet.Range("H6").Value = Format
(rstHeader!DeliveryDate, "dd/mm/yy")
ActiveSheet.Range("K4").Value = Trim(rstHeader!
DeliveryDock)
ActiveSheet.Range("G7").Value = Trim(rstHeader!
DeliveryWeek)
ActiveSheet.Range("A16").CopyFromRecordset
rstParts
strDate = Format(rstHeader!CollectionDate, "dd-
mm-yyyy")
strFile = "D:\My Documents\Advice Notes\" &
rstHeader!GSDBCode & "-" & strDate & "-" & rstHeader!
DeliveryDock & ".xls"
ActiveSheet.SaveAs strFile
Set rstParts = Nothing
rstHeader.MoveNext
End With
Loop
MsgBox "Completed"
wkbXL.Close
Set rstHeader = Nothing
Set appXL = Nothing
Set wkbXL = Nothing
Set wsXL = Nothing
Exit Sub