Debug error due to StPath

[oneblondebro]

Hi all,

I am getting a debug error on the below VBA that i am sure is to to with the fact the Excel spreadsheet it on a public networked drive. It seems to be always looking at my C drive so going like this C:\Colin\\1035492-f01\shared$\Public\Colin\test.xlsx

enviro = CStr(Environ("USERPROFILE"))
'the path of the workbook
strPath = enviro & "\\1035492-f01\shared$\Public\Colin\test.xlsx"
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Application.StatusBar = "Please wait while Excel source is opened ... "
Set xlApp = CreateObject("Excel.Application")
bXStarted = True
End If
On Error GoTo 0
'Open the workbook to input the data
Set xlWB = xlApp.Workbooks.Open(strPath)
Set xlSheet = xlWB.Sheets("Sheet1")

Can you help?

Many thanks in advance

[gmayor]

It will always look at the C: drive if you use CStr(Environ("USERPROFILE")) in your strPath string as that will be a C drive location e.g. "C:\Users\Colin"
set strpath to the actual path of the network location in question which might be "\\1035492-f01\shared$\Public\Colin\test.xlsx"

[oneblondebro]

It will always look at the C: drive if you use CStr(Environ("USERPROFILE")) in your strPath string as that will be a C drive location e.g. "C:\Users\Colin"
set strpath to the actual path of the network location in question which might be "\\1035492-f01\shared$\Public\Colin\test.xlsx"

Ah so something like this?

enviro = CStr(Environ("\\1035492-f01\shared$\Public\Colin\test.xlsx"))
'the path of the workbook
strPath = enviro & "\\1035492-f01\shared$\Public\Colin\test.xlsx"
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Application.StatusBar = "Please wait while Excel source is opened ... "
Set xlApp = CreateObject("Excel.Application")
bXStarted = True
End If
On Error GoTo 0
'Open the workbook to input the data
Set xlWB = xlApp.Workbooks.Open(strPath)
Set xlSheet = xlWB.Sheets("Sheet1")

I have done the above but it's not writing to the excel file, Is what i have done correct?

Also anyway i can change it so it doesn't open the workbook but add's the information anyway?

Thanks for the help so far.

[gmayor]

Forget all about Environ, which has a specific role that is not required here. The path is simply strPath = "\\1035492-f01\shared$\Public\Colin\test.xlsx"
If you want to get 'Colin' using Environ, assuming the username is Colin and not Colin+Surname then

strUser = CStr(Environ("USERNAME"))
strPath = "\\1035492-f01\shared$\Public\" & strUser & "\test.xlsx"


Dim strUser As String
Dim strPath As String
Dim xlApp As Object
Dim xlWB As Object
Dim xlSheet As Object
Dim bXStarted As Boolean
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
strUser = CStr(Environ("USERNAME"))
'the path of the workbook
strPath = "\\1035492-f01\shared$\Public\" & strUser & "\test.xlsx"
If Not fso.FileExists(strPath) Then
MsgBox "The workbook '" & strPath & "' doesn't exist"
Exit Sub
End If
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err <> 0 Then
Application.StatusBar = "Please wait while Excel source is opened ... "
Set xlApp = CreateObject("Excel.Application")
bXStarted = True
End If
On Error GoTo 0
'Open the workbook to input the data
Set xlWB = xlApp.Workbooks.Open(strPath)
Set xlSheet = xlWB.Sheets("Sheet1")

You can address the worksheet without opening the workbook, but it is altogether less tolerant of coding errors.
The following function assumes a pre-existing worksheet with a header row at row 1 and three columns (you can have more columns and values as required, but always the same number of items in the string strValues even if some of those strings are empty.
strRange is the worksheet name. strValues is a string in the format below, where strValue1, strValue2, strvalue 3 etc are the variable that you want to write to the worksheet

strValues = strValue1 & "', '" & strValue2 & "', '" & strValue3 'etc


Sub Example()
Dim strUser As String
Dim strPath As String
Dim strValues As String
Dim strValue1 As String
Dim strValue2 As String
Dim strValue3 As String
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
strUser = CStr(Environ("USERNAME"))
'the path of the workbook
strPath = "\\1035492-f01\shared$\Public\" & strUser & "\test.xlsx"
If Not fso.FileExists(strPath) Then
MsgBox "The workbook '" & strPath & "' doesn't exist"
Exit Sub
End If
On Error Resume Next
'get the values
strValue1 = "Item1"
strValue2 = "Item2"
strValue3 = "Item3"
'write them to the sheet
strValues = strValue1 & "', '" & strValue2 & "', '" & strValue3 'etc
WriteToWorksheet strPath, "Sheet1", strValues
End Sub

Private Function WriteToWorksheet(strWorkbook As String, _
strRange As String, _
strValues As String)
Dim ConnectionString As String
Dim strSQL As String
Dim CN As Object
ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strWorkbook & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=YES;"";"
strSQL = "INSERT INTO [" & strRange & "$] VALUES('" & strValues & "')"
Set CN = CreateObject("ADODB.Connection")
Call CN.Open(ConnectionString)
Call CN.Execute(strSQL, , 1 Or 128)
CN.Close
Set CN = Nothing
lbl_Exit:
Exit Function
End Function






Public Function WriteToWorksheet(strWorkbook As String, _
strRange As String, _
strValues As String)
Dim ConnectionString As String
Dim strSQL As String
Dim CN As Object
ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strWorkbook & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=YES;"";"
strSQL = "INSERT INTO [" & strRange & "$] VALUES('" & strValues & "')"
Set CN = CreateObject("ADODB.Connection")
Call CN.Open(ConnectionString)
Call CN.Execute(strSQL, , 1 Or 128)
CN.Close
Set CN = Nothing
lbl_Exit:
Exit Function
End Function