VBScript Error 80040E14 Syntax error in FROM clause - csv

I'm trying to use a script I found on the internet to allow the bulk creation of new user accounts in Active Directory using VBScript and a CSV file. I'm not using CSVDE b/c this script will also create passwords. I keep encountering this error when running the code I cannot figure it out. Can anyone help?
'*********************************************************************
' Script: createUsersFromCSV.vbs *
' Creates new user accounts in Active Directory from a CSV file. *
' Input: CSV file with layout logonname,firstname,lastname,password *
' *
'*********************************************************************
Option Explicit
Dim sCSVFileLocation
Dim sCSVFile
Dim oConnection
Dim oRecordSet
Dim oNewUser
' Variables needed for LDAP connection
Dim oRootLDAP
Dim oContainer
' Holding variables for information import from CSV file
Dim sLogon
Dim sFirstName
Dim sLastName
Dim sDisplayName
Dim sPassword
Dim nPwdLastSet
Dim nUserAccountControl ' Used to enable the account
Dim sDomain
Dim sCompany
Dim sPhone
Dim sEmail
Dim sDescription
Dim NumChar, Count, strRdm, intRdm
Dim fso, f, fso1, f1
'* Modify this to match your company's AD domain
sDomain="mydomain.local"
'* Input file location
sCSVFileLocation = "C:\Documents and Settings\Administrator\Desktop\" 'KEEP TRAILING SLASH!
'* Full path to input file
sCSVFile = sCSVFileLocation&"newusers.csv"
' Commands used to open the CSV file and select all of the records
set oConnection = createobject("adodb.connection")
set oRecordSet = createobject("adodb.recordset")
oConnection.open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= " & _
sCSVFileLocation & ";Extended Properties=""text;HDR=NO;FMT=Delimited"""
oRecordSet.open "SELECT * FROM " & sCSVFile ,oConnection
' Create a connection to an Active Directory OU container.
Set oRootLDAP = GetObject("LDAP://rootDSE")
Set oContainer = GetObject("LDAP://ou=Test," & _
oRootLDAP.Get("defaultNamingContext"))
on error resume next
do until oRecordSet.EOF ' Reads the values (cells) in the sInputFile file.
' --------- Start creating user account
' Read variable information from the CSV file
' and build everything needed to create the account
sLogon = oRecordSet.Fields.Item(0).value
sFirstName = oRecordSet.Fields.Item(1).value
sLastName = oRecordSet.Fields.Item(2).value
sDisplayName = sFirstName&" "&sLastName
sPassword = oRecordSet.Fields.Item(3).value
' Build the User account
Set oNewUser = oContainer.Create("User","cn="&sFirstName&" "&sLastName)
oNewUser.put "sAMAccountName",lcase(sLogon)
oNewUser.put "givenName",sFirstName
oNewUser.put "sn",sLastName
oNewUser.put "UserPrincipalName",lcase(SLogon)&"#"&sDomain
oNewUser.put "DisplayName",sDisplayName
oNewUser.put "name",lcase(sLogon)
' Write this information into Active Directory so we can
' modify the password and enable the user account
oNewUser.SetInfo
' Change the users password
oNewUser.SetPassword sPassword
oNewUser.Put "pwdLastSet", 0
' Enable the user account
oNewUser.Put "userAccountControl", 512
oNewUser.SetInfo
objFile.Close
'*******************
oRecordset.MoveNext
Loop
'*******************
' Used only for debugging
'if err.number = -2147019886 then
' msgbox "User logon " & sLogon & "already exists"
'End If
' --------- End of user account creation
Here is where the error is occuring, line 51 char 1:
oRecordSet.open "SELECT * FROM " & sCSVFile ,oConnection

Maybe sCSVFile contains special characters and therefore must be escaped like this:
oRecordSet.open "SELECT * FROM [" & sCSVFile & "]", oConnection
I hope it helps.

Related

OpenRecordset on a Linked Table?

I split off a few large tables from my AccessDB to a backend database without issue.
Next, I need to open a recordset to replace various troublesome characters. The following snippet worked fine when the table was local, but Access complains now that the table is LINKED, but provides no detail.
Dim rs3 As DAO.Recordset
'Step thru the Item table fix ' & " characters
Set rs3 = db.OpenRecordset("Item", dbOpenTable)
Do While Not rs3.EOF
strDesc = Replace(Nz(rs3!DESC), Chr(39), Chr(39) & Chr(39))
strDesc = Replace(Nz(rs3!DESC), Chr(34), "")
rs3.MoveNext
Loop
Set rs3 = Nothing
Any suggestions for accomplishing this task with a LINKED table?
dbOpenTable can only be used with a local table; it can not be used with a linked table.
'Set rs3 = db.OpenRecordset("Item", dbOpenTable)
Set rs3 = db.OpenRecordset("Item")
'I allways use this format scheme, and it works perfectly, with local or
'linked tables (In fact, I always use linked tables...):
Dim bd As Database
Dim reg As Recordset
Private Sub Form_Load()
Set bd = CurrentDb
Set reg = bd.OpenRecordset("Select * from Pacientes", dbOpenDynaset)
end sub
' for a new record
reg.AddNew
' for updates
reg.Update
' for delete
reg.Delete
' to fill a table record
reg("Dni") = txtDni
' to read a table record
txtDni = reg("Dni")
' txtDni is the field's name in the form
' Dni is the field's name in the table
' to find a record
Dim Finder As String
Finder = InputBox("Dni: ")
If Finder <> "" Then
reg.FindFirst "Dni=" & Trim(Finder)
Private Sub cmdClose_Click()
reg.Close
bd.Close
DoCmd.Close
End Sub

Access 2010 linked to SQL Server 2008 tables - unable to change tabledef.connection to SQL Server Authentication DSN-Less

I usually link SQL Server 2008 tables in Access 2010 via DSN for development, then make it DSN-Less via VBA code (see below).
I've now decided to make the connection SQl Server authentication, rather than windows, as I want anyone to access the database. Problem is, when I link, saving passwords, then run my code to make DSN-less, it doesn't save the SQL Server authentication userID and password. I'm really baffled.
I'm trying to change from:
ODBC;DSN=Organisations_sql8;UID=xx;PWD=x;APP=Microsoft Office 2010;DATABASE=Organisations
To this as checked in debug:
ODBC;DRIVER={SQL Server Native Client 10.0};DATABASE=Organisations;SERVER=ra_sql8;UID=xx;PWD=x;
But this is what is saved:
DRIVER=SQL Server Native Client 10.0;SERVER=ra_sql8;APP=Microsoft Office 2010;DATABASE=Organisations;
Any ideas? :)
Many thanks
Type TableDetails
TableName As String
SourceTableName As String
Attributes As Long
IndexSQL As String
Description As Variant
End Type
Private Sub SubmitFix()
Call FixConnections("ra_sql8", "Organisations", "UserID", "Password")
End Sub
Sub FixConnections( _
ServerName As String, _
DatabaseName As String, _
Optional UID As String, _
Optional PWD As String _
)
' This code was originally written by
' Doug Steele, MVP AccessMVPHelp#gmail.com
' Modifications suggested by
' George Hepworth, MVP ghepworth#gpcdata.com
'
' You are free to use it in any application
' provided the copyright notice is left unchanged.
'
' Description: This subroutine looks for any TableDef objects in the
' database which have a connection string, and changes the
' Connect property of those TableDef objects to use a
' DSN-less connection.
' It then looks for any QueryDef objects in the database
' which have a connection string, and changes the Connect
' property of those pass-through queries to use the same
' DSN-less connection.
' This specific routine connects to the specified SQL Server
' database on a specified server.
' If a user ID and password are provided, it assumes
' SQL Server Security is being used.
' If no user ID and password are provided, it assumes
' trusted connection (Windows Security).
'
' Inputs: ServerName: Name of the SQL Server server (string)
' DatabaseName: Name of the database on that server (string)
' UID: User ID if using SQL Server Security (string)
' PWD: Password if using SQL Server Security (string)
'
On Error GoTo Err_FixConnections
Dim dbCurrent As DAO.Database
Dim prpCurrent As DAO.Property
Dim tdfCurrent As DAO.TableDef
Dim qdfCurrent As DAO.QueryDef
Dim intLoop As Integer
Dim intToChange As Integer
Dim strConnectionString As String
Dim strDescription As String
Dim strQdfConnect As String
Dim typNewTables() As TableDetails
' Start by checking whether using Trusted Connection or SQL Server Security
If (Len(UID) > 0 And Len(PWD) = 0) Or (Len(UID) = 0 And Len(PWD) > 0) Then
MsgBox "Must supply both User ID and Password to use SQL Server Security.", _
vbCritical + vbOKOnly, "Security Information Incorrect."
Exit Sub
Else
If Len(UID) > 0 And Len(PWD) > 0 Then
' Use SQL Server Security
strConnectionString = "ODBC;DRIVER={sql server};" & _
"DATABASE=" & DatabaseName & ";" & _
"SERVER=" & ServerName & ";" & _
"UID=" & UID & ";" & _
"PWD=" & PWD & ";"
Else
' Use Trusted Connection
strConnectionString = "ODBC;DRIVER={sql server};" & _
"DATABASE=" & DatabaseName & ";" & _
"SERVER=" & ServerName & ";" & _
"Trusted_Connection=YES;"
End If
End If
intToChange = 0
Set dbCurrent = DBEngine.Workspaces(0).Databases(0)
' Build a list of all of the connected TableDefs and
' the tables to which they're connected.
For Each tdfCurrent In dbCurrent.TableDefs
If Len(tdfCurrent.Connect) > 0 Then
If UCase$(Left$(tdfCurrent.Connect, 5)) = "ODBC;" Then
ReDim Preserve typNewTables(0 To intToChange)
Debug.Print "------------------------------"
typNewTables(intToChange).Attributes = tdfCurrent.Attributes
Debug.Print tdfCurrent.Attributes
typNewTables(intToChange).TableName = tdfCurrent.Name
Debug.Print tdfCurrent.Name
Debug.Print tdfCurrent.Connect
typNewTables(intToChange).SourceTableName = tdfCurrent.SourceTableName
Debug.Print tdfCurrent.SourceTableName
typNewTables(intToChange).IndexSQL = GenerateIndexSQL(tdfCurrent.Name)
typNewTables(intToChange).Description = Null
typNewTables(intToChange).Description = tdfCurrent.Properties("Description")
intToChange = intToChange + 1
End If
End If
Next
' Loop through all of the linked tables we found
Debug.Print "===================================="
For intLoop = 0 To (intToChange - 1)
' Delete the existing TableDef object
dbCurrent.TableDefs.Delete typNewTables(intLoop).TableName
Debug.Print "------------------------------"
' Create a new TableDef object, using the DSN-less connection
Set tdfCurrent = dbCurrent.CreateTableDef(typNewTables(intLoop).TableName)
tdfCurrent.Connect = strConnectionString
Debug.Print tdfCurrent.Name
Debug.Print tdfCurrent.Connect
' Unfortunately, I'm current unable to test this code,
' but I've been told trying this line of code is failing for most people...
' If it doesn't work for you, just leave it out.
'tdfCurrent.Attributes = typNewTables(intLoop).Attributes
tdfCurrent.SourceTableName = typNewTables(intLoop).SourceTableName
dbCurrent.TableDefs.Append tdfCurrent
' Where it existed, add the Description property to the new table.
If IsNull(typNewTables(intLoop).Description) = False Then
strDescription = CStr(typNewTables(intLoop).Description)
Set prpCurrent = tdfCurrent.CreateProperty("Description", dbText, strDescription)
tdfCurrent.Properties.Append prpCurrent
End If
' Where it existed, create the __UniqueIndex index on the new table.
If Len(typNewTables(intLoop).IndexSQL) > 0 Then
dbCurrent.Execute typNewTables(intLoop).IndexSQL, dbFailOnError
End If
Next
' Loop through all the QueryDef objects looked for pass-through queries to change.
' Note that, unlike TableDef objects, you do not have to delete and re-add the
' QueryDef objects: it's sufficient simply to change the Connect property.
' The reason for the changes to the error trapping are because of the scenario
' described in Addendum 6 below.
For Each qdfCurrent In dbCurrent.QueryDefs
On Error Resume Next
strQdfConnect = qdfCurrent.Connect
On Error GoTo Err_FixConnections
If Len(strQdfConnect) > 0 Then
If UCase$(Left$(qdfCurrent.Connect, 5)) = "ODBC;" Then
qdfCurrent.Connect = strConnectionString
End If
End If
strQdfConnect = vbNullString
Next qdfCurrent
End_FixConnections:
Set tdfCurrent = Nothing
Set dbCurrent = Nothing
Exit Sub
Err_FixConnections:
' Specific error trapping added for Error 3291
' (Syntax error in CREATE INDEX statement.), since that's what many
' people were encountering with the old code.
' Also added error trapping for Error 3270 (Property Not Found.)
' to handle tables which don't have a description.
Select Case err.Number
Case 3270
Resume Next
Case 3291
MsgBox "Problem creating the Index using" & vbCrLf & _
typNewTables(intLoop).IndexSQL, _
vbOKOnly + vbCritical, "Fix Connections"
Resume End_FixConnections
Case 18456
MsgBox "Wrong User ID or Password.", _
vbOKOnly + vbCritical, "Fix Connections"
Resume End_FixConnections
Case Else
MsgBox err.Description & " (" & err.Number & ") encountered", _
vbOKOnly + vbCritical, "Fix Connections"
Resume End_FixConnections
End Select
End Sub
Function GenerateIndexSQL(TableName As String) As String
' This code was originally written by
' Doug Steele, MVP AccessMVPHelp#gmail.com
' Modifications suggested by
' George Hepworth, MVP ghepworth#gpcdata.com
'
' You are free to use it in any application,
' provided the copyright notice is left unchanged.
'
' Description: Linked Tables should have an index __uniqueindex.
' This function looks for that index in a given
' table and creates an SQL statement which can
' recreate that index.
' (There appears to be no other way to do this!)
' If no such index exists, the function returns an
' empty string ("").
'
' Inputs: TableDefObject: Reference to a Table (TableDef object)
'
' Returns: An SQL string (or an empty string)
'
On Error GoTo Err_GenerateIndexSQL
Dim dbCurr As DAO.Database
Dim idxCurr As DAO.Index
Dim fldCurr As DAO.Field
Dim strSQL As String
Dim tdfCurr As DAO.TableDef
Set dbCurr = CurrentDb()
Set tdfCurr = dbCurr.TableDefs(TableName)
If tdfCurr.Indexes.Count > 0 Then
' Ensure that there's actually an index named
' "__UnigueIndex" in the table
On Error Resume Next
Set idxCurr = tdfCurr.Indexes("__uniqueindex")
If err.Number = 0 Then
On Error GoTo Err_GenerateIndexSQL
' Loop through all of the fields in the index,
' adding them to the SQL statement
If idxCurr.Fields.Count > 0 Then
strSQL = "CREATE INDEX __UniqueIndex ON [" & TableName & "] ("
For Each fldCurr In idxCurr.Fields
strSQL = strSQL & "[" & fldCurr.Name & "], "
Next
' Remove the trailing comma and space
strSQL = Left$(strSQL, Len(strSQL) - 2) & ")"
End If
End If
End If
End_GenerateIndexSQL:
Set fldCurr = Nothing
Set tdfCurr = Nothing
Set dbCurr = Nothing
GenerateIndexSQL = strSQL
Exit Function
Err_GenerateIndexSQL:
' Error number 3265 is "Not found in this collection
' (in other words, either the tablename is invalid, or
' it doesn't have an index named __uniqueindex)
If err.Number <> 3265 Then
MsgBox err.Description & " (" & err.Number & ") encountered", _
vbOKOnly + vbCritical, "Generate Index SQL"
End If
Resume End_GenerateIndexSQL
End Function
With thanks to Doug Steele and George Hepworth, the fix this issue is to simply change the line of code:
tdfCurrent.Attributes = typNewTables(intLoop).Attributes
to
tdfCurrent.Attributes = typNewTables(intLoop).Attributes And DB_ATTACHSAVEPWD
I've tested this and it works great; SQL Server authentication is now working from Access 2010 using a DSN-Less connection.

Open connection to MySQL from VBA Excel 2007

I got this error when try to connect Excel and MySQL using ODBC
DataSource name not found and no default driver specified
Here is my VBA code:
Sub test123()
' Connection variables
Dim conn As New ADODB.Connection
Dim server_name As String
Dim database_name As String
Dim user_id As String
Dim password As String
' Table action variables
Dim i As Long ' counter
Dim sqlstr As String ' SQL to perform various actions
Dim table1 As String, table2 As String
Dim field1 As String, field2 As String
Dim rs As ADODB.Recordset
Dim vtype As Variant
'----------------------------------------------------------------------
' Establish connection to the database
server_name = "127.0.0.1" ' Enter your server name here - if running from a local computer use 127.0.0.1
database_name = "smss" ' Enter your database name here
user_id = "root" ' enter your user ID here
password = "" ' Enter your password here
Set conn = New ADODB.Connection
conn.Open "DRIVER={MySQL ODBC 5.2a Driver}" _
& ";SERVER=" & server_name _
& ";DATABASE=" & database_name _
& ";UID=" & user_id _
& ";PWD=" & password _
' Extract MySQL table data to first worksheet in the workbook
GoTo skipextract
Set rs = New ADODB.Recordset
sqlstr = "SELECT * FROM inbox" ' extracts all data
rs.Open sqlstr, conn, adOpenStatic
With Sheet1(1).Cells ' Enter your sheet name and range here
.ClearContents
.CopyFromRecordset rs
End With
skipextract:
End Sub
I've added references (tools-reference)
The ODBC driver also has been installed.
What is actually wrong? Thank you.
There are many articles on this site describing similar problems. In particular, there were a couple of pointers in this link that rang true.
In your code above, one line in particular struck me as troublesome:
Dim conn As New ADODB.Connection
followed lower down by
Set conn = New ADODB.Connection
The second overrides the first in a way that makes me, for one, uncomfortable - although I can't tell you exactly what is wrong, except that you're creating TWO New Connections...
Try that - and the other fixes recommended in the linked article. Good luck.
maybe this might help you/others:
Add this reference to your project: Microsoft ActiveX Data object 2 (or any higher version you have)
Throw this code into a module and save it:
Edit the server details in this module.
'---------------------------------------------------------------------------------------
' Module : Mod_Connection
' Author : Krish km, xkrishx.wordpress.com
' Date : 27/08/2014
' Purpose : use this for build mysql connectin string.
' Declaration: © Krish KM, 2014.
' : Free to modify and re-use as long as a clear credit is made about the orgin of the code and the link above
' : This script is distributed in the hope that it will be useful,
' : but WITHOUT ANY WARRANTY; without even the implied warranty of
' : MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
' : GNU General Public License for more details.
'---------------------------------------------------------------------------------------
Option Explicit
Public ConnectionString As String
Private Const HKEY_LOCAL_MACHINE = &H80000002
Public Function GET_CURRENT_DRIVER() As String
'---------------------------------------------------------------------------------------
' Procedure : GET_CURRENT_DRIVER
' Author : Krish km
' Date : 27/08/2014
' Purpose : This function returns available mysql odbc drivers found in the registry. You could search by MySQL ODBC and get the first result
' : but I prefer prioritize the drivers i would like to yield first
'---------------------------------------------------------------------------------------
'
If FIND_ODBC_DRIVER(GET_ODBC_DRIVER_NAMES, "MySQL ODBC 5.2 Unicode Driver") <> "" Then
GET_CURRENT_DRIVER = "MySQL ODBC 5.2 Unicode Driver"
ElseIf FIND_ODBC_DRIVER(GET_ODBC_DRIVER_NAMES, "MySQL ODBC 5.2w Driver") <> "" Then
GET_CURRENT_DRIVER = "MySQL ODBC 5.2w Driver"
Else
GET_CURRENT_DRIVER = FIND_ODBC_DRIVER(GET_ODBC_DRIVER_NAMES, "MySQL ODBC")
End If
End Function
Public Function GET_CONNECTION_STRING() As String
'---------------------------------------------------------------------------------------
' Procedure : GET_CONNECTION_STRING
' Author : Krish KM
' Date : 27/08/2014
' Purpose : Returns MySQL connection string
'---------------------------------------------------------------------------------------
'
If Not ConnectionString = vbNullString Then
GET_CONNECTION_STRING = ConnectionString
Else
Dim Driver As String
Dim mDatabase As String
Dim mServer As String
Dim mUser As String
Dim mPassword As String
Dim mPort As Integer
mDatabase = "" ' DB name
mServer = "" ' Server name
mUser = "" ' DB user name
mPassword = "" ' DB user password
mPort = 3306 ' DB port
Driver = GET_CURRENT_DRIVER
If Driver = "" Then
Err.Raise 1, Err.Source, "MYSQL ODBC drivers are missing"
Exit Function
End If
ConnectionString = "DRIVER={" & Driver & "};PORT=" & mPort & ";DATABASE=" & mDatabase & ";SERVER={" & mServer & "};UID=" & mUser & ";PWD={" & mPassword & "};"
GET_CONNECTION_STRING = ConnectionString
End If
End Function
Public Function GET_ODBC_DRIVER_NAMES()
'---------------------------------------------------------------------------------------
' Procedure : GET_ODBC_DRIVER_NAMES
' Author : Krish KM
' Date : 27/08/2014
' Purpose : Checks in the registry for any odbc driver signatures and returns the collection
'---------------------------------------------------------------------------------------
'
Dim strComputer As String, strKeyPath As String
Dim objRegistry As Object, arrValueNames, arrValueTypes
strComputer = "."
strKeyPath = "SOFTWARE\ODBC\ODBCINST.INI\ODBC Drivers"
Set objRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")
objRegistry.EnumValues HKEY_LOCAL_MACHINE, strKeyPath, arrValueNames, arrValueTypes
GET_ODBC_DRIVER_NAMES = arrValueNames
End Function
Public Function FIND_ODBC_DRIVER(ByVal iArr, ByVal sValue) As String
'---------------------------------------------------------------------------------------
' Procedure : FIND_ODBC_DRIVER
' Author : Krish KM
' Date : 27/08/2014
' Purpose : Simple array function to check if a specific value exists. if yes return the value if not return empty string
'---------------------------------------------------------------------------------------
'
FIND_ODBC_DRIVER = ""
Dim iValue As Variant
For Each iValue In iArr
If iValue = sValue Then
FIND_ODBC_DRIVER = iValue
Exit Function
End If
Next
End Function
Copy/modify this function on your excel sheet button/macro:
update the SQL_GET statement as per your request/sql call.
Sub Retrieve_EMP_Details()
'---------------------------------------------------------------------------------------
' Procedure : Retrieve_EMP_Details
' Author : Krish KM
' Date : 27/08/2014
' Purpose : connects to the database and retrieves employee details.
'---------------------------------------------------------------------------------------
'
'Connection variables
Dim conn As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim rs As ADODB.Recordset
'Get connection string and connect to the server
On Error GoTo ERR_CONNECTION:
conn.ConnectionString = GET_CONNECTION_STRING ' trap additional error if you want
conn.Open
'Preparing SQL Execution
Dim SQL_GET As String
SQL_GET = "SELECT * FROM tbl_employee" ' extracts all data
cmd.Name = "EMPSearch"
cmd.ActiveConnection = conn
cmd.CommandText = SQL_GET
'Execute SQL
Set rs = cmd.Execute
On Error GoTo ERR_READ_SQL
If Not rs.EOF Then
With Sheets(1).Cells ' Enter your sheet name and range here
.ClearContents
.CopyFromRecordset rs
End With
Else
Sheets(1).Range("A1").value = "No records found :("
End If
EXIT_SUB:
On Error Resume Next
Set conn = Nothing
Set cmd = Nothing
Set rs = Nothing
Exit Sub
ERR_CONNECTION:
MsgBox "Sorry unable to connect to the server.." & vbNewLine & "Connection string: " & GET_CONNECTION_STRING & vbNewLine & "System Msg: " & Err.Description
GoTo EXIT_SUB
ERR_READ_SQL:
MsgBox "Sorry unable read/wite results on the sheet.." & vbNewLine & "System Msg: " & Err.Description
GoTo EXIT_SUB
End Sub
If you have ODBC drivers installed, all the server details provided, SQL statement adjusted. just execute the sub_routine {Retrieve_EMP_Details} and you should be able to see the results in sheet(1)
Hope this helps and enjoy :)
Krish KM

How do I utilize Access 2007 Linked Table Manager in C#

Scenario: I have a Front End and a Back End Access 2007 Database that are currently linked to each other through the Linked Table Manager Database Tool. The Back End DB is going to be moved to a location on a server. The server name will be different for each facility and there are about 40 or so now which will increase throughout the year.
What I need to try to accomplish is changing the linked tables programatically. I will need to build the linked string to something like:
\\something\facilitynum(gathered from Environment variable)\c$\somefolder\.
I have found that the column Database in MSysObjects contains the link string that would need to be changed. The question becomes, how do get permissions to change a System table or use some .dll that will allow me to change the link to the newly built string?
Everything that I have found so far always leads back to manually changing the link within the Access Database.
You can programmatically change the link from within Access (using VBA) like so (this uses a dsn file to contain the actual server information)
Private Sub UpdateDSN()
On Error GoTo ErrorHandler
Dim dbPath As String
Dim connStr As String
Dim Tdf As TableDef
dbPath = Application.CodeDb.Name
dbPath = Left(dbPath, InStr(dbPath, Dir(dbPath)) - 1)
For Each Tdf In CurrentDb.TableDefs
connStr = Tdf.Connect
If InStr(1, UCase(connStr), "ODBC") Then
connStr = "odbc; FILEDSN=" & dbPath & "db.dsn;"
Tdf.Connect = connStr
Tdf.RefreshLink
End If
Next
Dim fName As String
Dim fNumber As Integer
Dim InputStr As String
fNumber = FreeFile()
fName = dbPath & "db.dsn"
Dim serverName As String
Open fName For Input As fNumber
Do While Not EOF(fNumber)
Line Input #fNumber, InputStr
If InStr(1, UCase(InputStr), "SERVER=") > 0 Then
serverName = Right(InputStr, Len(InputStr) - _
(InStr(1, InputStr, "SERVER=") + 6))
End If
Loop
ErrorHandler:
On Error GoTo 0
DoCmd.OpenForm "Main"
cap = Forms!main.Caption
If InStr(1, cap, "(") > 1 Then
cap = Left(cap, InStr(1, cap, "("))
End If
Forms!main.Caption = "db" & " (" & serverName & ")"
End Sub

load a comma delimited flat file into SQL server table using ssis script task

I want to load the data from a comma delimited table into a temp table on sql server. I am using this code and it is working great. But since it is a "," delimited file, if any field in the file contains ',' then this code is not working. as in the replace function that "," is also replace. Any help
Imports System
Imports System.Data
Imports System.Math
Imports Microsoft.SqlServer.Dts.Runtime
Imports System.IO
Imports system.Data.OleDb
Imports Microsoft.SqlServer.DTSRuntimeWrap
Public Class ScriptMain
' The execution engine calls this method when the task executes.
' To access the object model, use the Dts object. Connections, variables, events,
' and logging features are available as static members of the Dts class.
' Before returning from this method, set the value of Dts.TaskResult to indicate success or failure.
'
' To open Code and Text Editor Help, press F1.
' To open Object Browser, press Ctrl+Alt+J.
Public Sub Main()
Dts.TaskResult = Dts.Results.Failure
Dim strFilePath As String = Dts.Variables("FilePath").Value.ToString
Dim strCurrentZipFile As String = Dts.Variables("CurrentZipFile").Value.ToString
Dim strConn As String = IO.Path.GetFileNameWithoutExtension(Dts.Variables("FilePath").Value.ToString)
Dim strFields() As String = Dts.Variables("FilePath").Value.ToString.Split(",".ToCharArray())
'Dts.Connections.Item(strConn).ConnectionString = strFilePath
Dts.Connections.Item("EmpInfo").ConnectionString = strFilePath
Dts.Variables("CurrentRawFile").Value = IO.Path.GetFileName(strCurrentZipFile)
' MsgBox(Dts.Variables("CurrentRawFile").Value)
Dts.TaskResult = Dts.Results.Success
' The execution engine calls this method when the task executes.
' To access the object model, use the Dts object. Connections, variables, events,
' and logging features are available as static members of the Dts class.
' Before returning from this method, set the value of Dts.TaskResult to indicate success or failure.
'
' To open Code and Text Editor Help, press F1.
' To open Object Browser, press Ctrl+Alt+J.
Dim cm As ConnectionManager
Dim con As OleDbConnection
Dim cmd As New OleDbCommand()
' myADONETConnection = DirectCast(TryCast(Dts.Connections("Polldata").AcquireConnection(Dts.Transaction), SqlConnection), SqlConnection)
' MsgBox(myADONETConnection.ConnectionString, "PollData")
Dim line1 As String = ""
'Reading file names one by one
Dim SourceDirectory As String = Dts.Variables("FilePath").Value.ToString
cm = Dts.Connections("Polldata")
Dim cmParam As Wrapper.IDTSConnectionManagerDatabaseParameters90
cmParam = CType(cm.InnerObject, Wrapper.IDTSConnectionManagerDatabaseParameters90)
con = CType(cmParam.GetConnectionForSchema(), OleDb.OleDbConnection)
cmd.Connection = con
'MsgBox(Dts.Variables("FilePath").Value.ToString)
' TODO: Add your code here
' Dim fileEntries As IO.DirectoryInfo = New IO.DirectoryInfo(SourceDirectory)
' MsgBox(fileEntries)
' For Each fileName As String In fileEntries.GetFiles()
' do something with fileName
' MsgBox(fileName)
Dim columname As String = ""
'Reading first line of each file and assign to variable
Dim file2 As New System.IO.StreamReader(Dts.Variables("FilePath").Value.ToString) '(fileName)
'Dim filenameonly As String = (((fileName.Replace(SourceDirectory, "")).Replace(".txt", "")).Replace("\", ""))
'Create a temporary table
line1 = (" IF EXISTS (SELECT * FROM sys.objects WHERE object_id = OBJECT_ID(N'[dbo].tmp_empinfo" & "') AND type in (N'U'))DROP TABLE [dbo].tmp_empinfo" & " Create Table dbo.tmp_empinfo" & "(" & file2.ReadLine().Replace(",", " VARCHAR(100),") & " VARCHAR(100))").Replace(".txt", "")
file2.Close()
' MsgBox(line1.ToString())
cmd.CommandText = line1
cmd.ExecuteNonQuery()
'MsgBox("TABLE IS CREATED")
'Writing Data of File Into Table
Dim counter As Integer = 0
Dim line As String = ""
Dim SourceFile As New System.IO.StreamReader(Dts.Variables("FilePath").Value.ToString) '(fileName)
While (InlineAssignHelper(line, SourceFile.ReadLine())) IsNot Nothing
If counter = 0 Then
columname = line.ToString()
' MsgBox("INside IF")
Else
' MsgBox("Inside ELSE")
Dim query As String = "Insert into dbo.tmp_empinfo" & "(" & columname & " VALUES('" & line.Replace(",", "','").Replace("""", "") & "')"
'Dim query As String = "Insert into dbo.tmp_empinfo" & "(" & columname & " VALUES(" & strFields.ToString & ")"
' Dim query As String = "BULK INSERT dbo.tmp_empinfo FROM '" & strFilePath & "' WITH " & " ( " & " FIELDTERMINATOR = '|', " & " ROWTERMINATOR = '\n' " & " )"
MsgBox(query.ToString())
cmd.CommandText = query
cmd.ExecuteNonQuery()
End If
"I want to load the data from a comma delimited table into a temp table on sql server". Are you saying you basically already have a column in a table in a database that contains the data in a comma separated list? For instance,
SELECT column_name
FROM schema.table
outputs something like some_data, more_data, even_more_data, even,more_data? And your problem is that the text isn't quoted, so some of the rows end up having extra phantom columns when you try to load it in your destination?
If this is the problem, then I would recommend introducing quoted identifiers in your source data before it is loaded into your source table. Meaning, whatever process that imports the data into that table needs to be fixed so that you don't have to deal with this kind of problem. If that can't be done, then you will have to build logic into your script component or sql select statement to split it out appropriately. The only way to fix the problem at this point would be to fix the data.
Did I misunderstand your intent or does this answer your question?