Debug error due to StPath

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

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"

Quote:

---

Originally Posted by 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"

---

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.

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"

Code:

---

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

Code:

---

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

---

Code:

---

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

---