I wanted an easy way for a user to change the file path for an excel report that gets run every day. The workbook I'm building is bringing the data from that separate report into a worksheet via an OLEDB connected Table. To do so, I recorded a macro to change the location. Then I modified the code to change the Data Source section into a variable which the user would select. The works fine, until the file selected has a path + filename which is longer than 141 characters. For some reason it then sends a Run Time error '13' Type Mismatch. I've searched all over, and I cannot for the life of me find a solution. I've worked in a check for this case into the code to work around it, but I'd much rather find a solution so this isn't an issue any more.
Can someone help me modify the code so the Data Source section can be updated to whatever the variable is from the users file selection without being limited to the 141 characters?
Much appreciated.
My code is below and at **I've added the condition to check for which is causing the error:
Sub A_Change_Query_File()
current_location = Application.ActiveWorkbook.Path
ChDir (current_location)
Choose_file:
getfilePath = Application.GetOpenFilename(Title:="Select a File to Import")
FileType = ".xlsx"
If getfilePath = False Then
Exit Sub 'Prompt was Cancelled so exiting
Else
FileName = Dir(getfilePath)
filePath = Replace(getfilePath, "\" & FileName, "")
path_name = filePath & "\" & FileName
'**Have to check to length of the chosen file. If it's greater than 141 code won't run and I get Run Time error 13 Type Mismatch**
If Len(path_name) > 141 Then
If MsgBox("The path is too deep. The file is located too far down within nested folders." & vbNewLine & vbNewLine & _
"File Location:" & vbNewLine & path_name & vbNewLine & vbNewLine & "Please move the report to a folder higher up and Retry." _
, vbRetryCancel) = vbCancel Then
Exit Sub
Else
GoTo Choose_file: 'File is nested into too many folders. I don't know why this matters, but for now it's a bug that I'm coding around
End If
Else
Debug.Print path_name, Len(path_name)
With ActiveWorkbook.Connections("Maximo_Update").OLEDBConnection
.BackgroundQuery = False
.CommandText = Array("Report$")
.CommandType = xlCmdTable
.Connection = Array( _
"OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=" & path_name & ";Mode=Share Deny Write;Extended Prop" _
, _
"erties=""HDR=YES;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=3" _
, _
"7;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Datab" _
, _
"ase Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=F" _
, _
"alse;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=False;Jet OLEDB:Bypass Us" _
, _
"erInfo Validation=False;Jet OLEDB:Limited DB Caching=False;Jet OLEDB:Bypass ChoiceField Validation=False" _
)
.RefreshOnFileOpen = False
.SavePassword = False
.SourceConnectionFile = ""
.SourceDataFile = path_name
.ServerCredentialsMethod = xlCredentialsMethodIntegrated
.AlwaysUseConnectionFile = False
End With
With ActiveWorkbook.Connections("Maximo_Update")
.name = "Maximo_Update"
.Description = ""
End With
ActiveWorkbook.Connections("Maximo_Update").Refresh
Calculate
End If
End If
End Sub
Can someone help me modify the code so the Data Source section can be updated to whatever the variable is from the users file selection without being limited to the 141 characters?
Much appreciated.
My code is below and at **I've added the condition to check for which is causing the error:
Sub A_Change_Query_File()
current_location = Application.ActiveWorkbook.Path
ChDir (current_location)
Choose_file:
getfilePath = Application.GetOpenFilename(Title:="Select a File to Import")
FileType = ".xlsx"
If getfilePath = False Then
Exit Sub 'Prompt was Cancelled so exiting
Else
FileName = Dir(getfilePath)
filePath = Replace(getfilePath, "\" & FileName, "")
path_name = filePath & "\" & FileName
'**Have to check to length of the chosen file. If it's greater than 141 code won't run and I get Run Time error 13 Type Mismatch**
If Len(path_name) > 141 Then
If MsgBox("The path is too deep. The file is located too far down within nested folders." & vbNewLine & vbNewLine & _
"File Location:" & vbNewLine & path_name & vbNewLine & vbNewLine & "Please move the report to a folder higher up and Retry." _
, vbRetryCancel) = vbCancel Then
Exit Sub
Else
GoTo Choose_file: 'File is nested into too many folders. I don't know why this matters, but for now it's a bug that I'm coding around
End If
Else
Debug.Print path_name, Len(path_name)
With ActiveWorkbook.Connections("Maximo_Update").OLEDBConnection
.BackgroundQuery = False
.CommandText = Array("Report$")
.CommandType = xlCmdTable
.Connection = Array( _
"OLEDB;Provider=Microsoft.ACE.OLEDB.12.0;Password="""";User ID=Admin;Data Source=" & path_name & ";Mode=Share Deny Write;Extended Prop" _
, _
"erties=""HDR=YES;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=3" _
, _
"7;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Datab" _
, _
"ase Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=F" _
, _
"alse;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=False;Jet OLEDB:Bypass Us" _
, _
"erInfo Validation=False;Jet OLEDB:Limited DB Caching=False;Jet OLEDB:Bypass ChoiceField Validation=False" _
)
.RefreshOnFileOpen = False
.SavePassword = False
.SourceConnectionFile = ""
.SourceDataFile = path_name
.ServerCredentialsMethod = xlCredentialsMethodIntegrated
.AlwaysUseConnectionFile = False
End With
With ActiveWorkbook.Connections("Maximo_Update")
.name = "Maximo_Update"
.Description = ""
End With
ActiveWorkbook.Connections("Maximo_Update").Refresh
Calculate
End If
End If
End Sub