M
Matthew L. Butcher
I have writen a number of VBScript functions that exploit the Excel
automation interface. I use these VBScript functions to open an Excel
workbook, read/write data, and close the workbook. If I access this workbook
in a sequential fashion I do not have any problems but if I try to access
the same workbook from two or more machines then one of the machines
eventually opens the workbook in read-only mode and fails to perform its
write operation. That is, it prompts me to save the file under a different
name or location because the source file was opened in read-only mode.
I thought that if I configured the workbook as a shared workbook that I
would be able to have multiple concurrent connections to the same workbook
and that each connection would be allowed write access but as I stated above
sometimes one of the machines ends up with a read-only connection.
Are there any known limitations with the automation interface and the shared
workbook setting?
Below are two of the functions that I have writen. The "field name" is the
value found in the first row of the field. Any data writen to the workbook
is offset by one row to account for the field header (field name).
At one point I attempted to check for the read-only state inside the
SetCellByFieldName function and close the file and re-open it until I got
write access but I was unable to get this to work consistently.
If anyone can give me some direction I would very much appreciate the help!
Matthew
'
############################################################################
####################
' GetCellByFieldName will return a cells value according to the specified
field name and row.
' If the field name is not found the return value will be "False".
' sExcelWorkbook - Enter file name including directory path
' sWorksheet - Enter the name of the worksheet
' sFieldName - Enter the cell column reference
' sCellRow - Enter the cell row reference
' Ex. GetCellByFieldName "C:\Book1.xls", "Sheet1", "ROHMat#", 1
'
############################################################################
####################
Public Function GetCellByFieldName(ByVal sExcelWorkbook, ByVal sWorksheet,
ByVal sFieldName, ByVal sCellRow)
Dim objExcel, objWorkbook, sCellCol
If Not(Len(sExcelWorkbook) = 0 Or Len(sWorksheet) = 0 Or Len(sFieldName)
= 0 Or Len(sCellRow) = 0) Then
' Increment sCellRow on record to offset for the field header
sCellRow = sCellRow + 1
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open(sExcelWorkbook,,True)
If Not (objWorkbook.ReadOnly) Then
NetSend "322YM21", "GetCellByFieldName : Excel file NOT opened
in Read-Only mode"
End If
For sCellCol = 1 To 256
If
(Eval(objWorkbook.Worksheets(sWorksheet).Cells(1,sCellCol).Value =
sFieldName)) Then
GetCellByFieldName =
objWorkbook.Worksheets(sWorksheet).Cells(sCellRow,sCellCol).Value
Exit For
End If
If sCellCol = 256 Then
If
(Eval(objWorkbook.Worksheets(sWorksheet).Cells(1,sCellCol).Value <>
sFieldName)) Then
GetCellByFieldName = False
End If
End If
Next
objWorkbook.Close False
objExcel.Quit
Set objWorkbook = Nothing
Set objExcel = Nothing
Else
GetCellByFieldName = False
End If
End Function
'
############################################################################
####################
' SetCellByFieldName will set a cells value according to the specified field
name and row.
' If the field name is not found the return value will be "False".
' sExcelWorkbook - Enter file name including directory path
' sWorksheet - Enter the name of the worksheet
' sFieldName - Enter the cell column reference
' sCellRow - Enter the cell row reference
' sCellValue - Enter the new value
' Ex. SetCellByFieldName "C:\Book1.xls", "Sheet1", "ROHMat#", 1,
"54687"
'
' NOTE: If the sCellValue argument's value contains a leading zero it will
be reformatted to
' resemble an Excel formula. Ex. 00000543867 will be changed to
="00000543867"
'
############################################################################
####################
Public Function SetCellByFieldName(ByVal sExcelWorkbook, ByVal sWorksheet,
ByVal sFieldName, ByVal sCellRow, ByVal sCellValue)
Dim objExcel, objWorkbook, sCellCol
If Not(Len(sExcelWorkbook) = 0 Or Len(sWorksheet) = 0 Or Len(sFieldName)
= 0 Or Len(sCellRow) = 0) Then
' Increment sCellRow on record to offset for the field header
sCellRow = sCellRow + 1
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open(sExcelWorkbook,,False)
If (objWorkbook.ReadOnly) Then
NetSend "322YM21", "SetCellByFieldName : Excel file opened in
Read-Only mode"
End If
For sCellCol = 1 To 256
If
(Eval(objWorkbook.Worksheets(sWorksheet).Cells(1,sCellCol).Value =
sFieldName)) Then
' If sCellValue has leading zeros reformat the data to
resemble an Excel formula
If (Eval(CStr(Left(sCellValue, 1)) = "0"))Then
objWorkbook.Worksheets(sWorksheet).Cells(sCellRow,sCellCol).Value =
"="""&sCellValue&""""
Else
objWorkbook.Worksheets(sWorksheet).Cells(sCellRow,sCellCol).Value =
sCellValue
End If
objWorkbook.Close True
objExcel.Quit
Set objWorkbook = Nothing
Set objExcel = Nothing
If (CStr(GetCellByRowCol(sExcelWorkbook, sWorksheet,
sCellRow - 1, sCellCol)) = CStr(sCellValue)) Then
SetCellByFieldName = True
Else
SetCellByFieldName = False
End If
Exit For
ElseIf (sCellCol = 256 And
Eval(objWorkbook.Worksheets(sWorksheet).Cells(1,sCellCol).Value <>
sFieldName)) Then
objWorkbook.Close False
objExcel.Quit
Set objWorkbook = Nothing
Set objExcel = Nothing
SetCellByFieldName = False
End If
Next
Else
SetCellByFieldName = False
End If
End Function
automation interface. I use these VBScript functions to open an Excel
workbook, read/write data, and close the workbook. If I access this workbook
in a sequential fashion I do not have any problems but if I try to access
the same workbook from two or more machines then one of the machines
eventually opens the workbook in read-only mode and fails to perform its
write operation. That is, it prompts me to save the file under a different
name or location because the source file was opened in read-only mode.
I thought that if I configured the workbook as a shared workbook that I
would be able to have multiple concurrent connections to the same workbook
and that each connection would be allowed write access but as I stated above
sometimes one of the machines ends up with a read-only connection.
Are there any known limitations with the automation interface and the shared
workbook setting?
Below are two of the functions that I have writen. The "field name" is the
value found in the first row of the field. Any data writen to the workbook
is offset by one row to account for the field header (field name).
At one point I attempted to check for the read-only state inside the
SetCellByFieldName function and close the file and re-open it until I got
write access but I was unable to get this to work consistently.
If anyone can give me some direction I would very much appreciate the help!
Matthew
'
############################################################################
####################
' GetCellByFieldName will return a cells value according to the specified
field name and row.
' If the field name is not found the return value will be "False".
' sExcelWorkbook - Enter file name including directory path
' sWorksheet - Enter the name of the worksheet
' sFieldName - Enter the cell column reference
' sCellRow - Enter the cell row reference
' Ex. GetCellByFieldName "C:\Book1.xls", "Sheet1", "ROHMat#", 1
'
############################################################################
####################
Public Function GetCellByFieldName(ByVal sExcelWorkbook, ByVal sWorksheet,
ByVal sFieldName, ByVal sCellRow)
Dim objExcel, objWorkbook, sCellCol
If Not(Len(sExcelWorkbook) = 0 Or Len(sWorksheet) = 0 Or Len(sFieldName)
= 0 Or Len(sCellRow) = 0) Then
' Increment sCellRow on record to offset for the field header
sCellRow = sCellRow + 1
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open(sExcelWorkbook,,True)
If Not (objWorkbook.ReadOnly) Then
NetSend "322YM21", "GetCellByFieldName : Excel file NOT opened
in Read-Only mode"
End If
For sCellCol = 1 To 256
If
(Eval(objWorkbook.Worksheets(sWorksheet).Cells(1,sCellCol).Value =
sFieldName)) Then
GetCellByFieldName =
objWorkbook.Worksheets(sWorksheet).Cells(sCellRow,sCellCol).Value
Exit For
End If
If sCellCol = 256 Then
If
(Eval(objWorkbook.Worksheets(sWorksheet).Cells(1,sCellCol).Value <>
sFieldName)) Then
GetCellByFieldName = False
End If
End If
Next
objWorkbook.Close False
objExcel.Quit
Set objWorkbook = Nothing
Set objExcel = Nothing
Else
GetCellByFieldName = False
End If
End Function
'
############################################################################
####################
' SetCellByFieldName will set a cells value according to the specified field
name and row.
' If the field name is not found the return value will be "False".
' sExcelWorkbook - Enter file name including directory path
' sWorksheet - Enter the name of the worksheet
' sFieldName - Enter the cell column reference
' sCellRow - Enter the cell row reference
' sCellValue - Enter the new value
' Ex. SetCellByFieldName "C:\Book1.xls", "Sheet1", "ROHMat#", 1,
"54687"
'
' NOTE: If the sCellValue argument's value contains a leading zero it will
be reformatted to
' resemble an Excel formula. Ex. 00000543867 will be changed to
="00000543867"
'
############################################################################
####################
Public Function SetCellByFieldName(ByVal sExcelWorkbook, ByVal sWorksheet,
ByVal sFieldName, ByVal sCellRow, ByVal sCellValue)
Dim objExcel, objWorkbook, sCellCol
If Not(Len(sExcelWorkbook) = 0 Or Len(sWorksheet) = 0 Or Len(sFieldName)
= 0 Or Len(sCellRow) = 0) Then
' Increment sCellRow on record to offset for the field header
sCellRow = sCellRow + 1
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open(sExcelWorkbook,,False)
If (objWorkbook.ReadOnly) Then
NetSend "322YM21", "SetCellByFieldName : Excel file opened in
Read-Only mode"
End If
For sCellCol = 1 To 256
If
(Eval(objWorkbook.Worksheets(sWorksheet).Cells(1,sCellCol).Value =
sFieldName)) Then
' If sCellValue has leading zeros reformat the data to
resemble an Excel formula
If (Eval(CStr(Left(sCellValue, 1)) = "0"))Then
objWorkbook.Worksheets(sWorksheet).Cells(sCellRow,sCellCol).Value =
"="""&sCellValue&""""
Else
objWorkbook.Worksheets(sWorksheet).Cells(sCellRow,sCellCol).Value =
sCellValue
End If
objWorkbook.Close True
objExcel.Quit
Set objWorkbook = Nothing
Set objExcel = Nothing
If (CStr(GetCellByRowCol(sExcelWorkbook, sWorksheet,
sCellRow - 1, sCellCol)) = CStr(sCellValue)) Then
SetCellByFieldName = True
Else
SetCellByFieldName = False
End If
Exit For
ElseIf (sCellCol = 256 And
Eval(objWorkbook.Worksheets(sWorksheet).Cells(1,sCellCol).Value <>
sFieldName)) Then
objWorkbook.Close False
objExcel.Quit
Set objWorkbook = Nothing
Set objExcel = Nothing
SetCellByFieldName = False
End If
Next
Else
SetCellByFieldName = False
End If
End Function