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