The error says "The field is too small to accept the amount of data you attempted to add. Try inserting or pasting less data."
The database is supposed to pull in information from the Excel sheet that is passed through to it, and import the information into a recordset of the text field. However, the text field, somewhere down the line, has been limited to 50 characters. How can I change the maximum size of the text field? Thank you for any help
This is just part of the code, and the textfield I'm trying to make larger is "Idea_#", which is the last line of the code i posted
Sub Read_Recommendations()
On Error GoTo error_code
Dim FD As Office.FileDialog
Dim xlapp As Excel.Application
Dim xlsheet As Excel.Worksheet
Dim xlbook As Excel.Workbook
Dim db As Database
Dim rs As Recordset
Dim sql As String
Dim WP As String
Dim row As Integer
Dim File As String
Set db = CurrentDb
Set FD = Application.FileDialog(msoFileDialogOpen)
If FD.Show = True Then
File = FD.SelectedItems(1)
Set xlapp = CreateObject("Excel.Application")
Set xlbook = GetObject(File)
Set xlsheet = xlbook.Worksheets("Recommendation Approval Form")
Dim protection As Boolean
With xlsheet
'support unprotected worksheets
protection = xlsheet.ProtectContents
If protection Then xlsheet.Unprotect "veproject"
WP = .Range("WP_Number")
' Check that active WP and the WP of the uploading form is the same
' If WPs are different, awares users and prompts user whether or not to continue
Dim DifferentProject As String
If Not get_WP = WP Then
DifferentProject = MsgBox("You are uploading to the project with WP number: " & WP & " which is not the active project. Do you wish to continue?", vbYesNo)
If DifferentProject = 7 Then Exit Sub
End If
' Check that WP is correct by checking if it exists in the Record Information table
' delete the existing recomendations, we want to keep the most recent recomendations
' perhaps change this to a dialog in the future
sql = "DELETE * from tbl_recomendations WHERE WP_Number = '" & WP & "'"
db.Execute (sql)
row = 8
Set rs = db.OpenRecordset("tbl_recomendations")
Do While .Range("D" & row) <> ""
rs.AddNew
rs("WP_Number") = WP
rs("Idea_#") = (.Range("C" & row))
........
In Access, open tbl_recomendations in Design View. It sounds like the Field Size property for Idea_# is set at 50. You can change that up to 255.
If you need to store more than 255 characters in Idea_#, change its Data Type from Text to Memo.
Related
I am trying to insert excel data into sql server tables. Each column should be imported with the exact same format that the user wrote in the source Excel.
I am using following query to fetch data
SELECT * FROM OPENROWSET( 'Microsoft.ACE.OLEDB.12.0', 'Excel 12.0 Xml;HDR=YES;IMEX=1;Database=H:\Loadloandata\Test\K3.xlsx',
'SELECT * FROM [Sheet1$]')
But now in the date column of excel we are receiving some float values( format issues from the users) as shown below
Because of the invalid data, the OLE provider convert the all other dates to float values in corresponding SQL table colums (float values corresponding to each date).If a date column is automatically cast to float I won't be able to know the original format of the data in the excel file, so all columns should be imported as varchar.
How can i prevent this datatype conversion? Based on google search i have used IMEX=1 in connection string to retrieve data for mixed data columns.
But it is not working !!
I think that you should get the data types from the SQL server table first to create the recordset, rather than letting Excel decide the datatypes from the Sheet. I believe Excel decides the data types by the first row, so in your case, it assumed Funded data was an integer, then casts any following strings into that data type.
Here is a full function that I use
This code is modified by me from the original source, which is mentioned in the comment. I made changes to deal with errors better.
Function ExportRangeToSQL(ByVal sourcerange As Range, _
ByVal conString As String, ByVal table As String, _
Optional ByVal beforeSQL = "", Optional ByVal afterSQL As String) As String
'https://www.excel-sql-server.com/excel-sql-server-import-export-using-vba.htm
' Object type and CreateObject function are used instead of ADODB.Connection,
' ADODB.Command for late binding without reference to
' Microsoft ActiveX Data Objects 2.x Library
' ADO API Reference
' https://msdn.microsoft.com/en-us/library/ms678086(v=VS.85).aspx
' Dim con As ADODB.Connection
On Error GoTo Finalise ' throw friendly user connection error
Dim con As Object
Set con = CreateObject("ADODB.Connection")
con.ConnectionString = conString
con.Open
Dim cmd As Object
Set cmd = CreateObject("ADODB.Command")
' BeginTrans, CommitTrans, and RollbackTrans Methods (ADO)
' http://msdn.microsoft.com/en-us/library/ms680895(v=vs.85).aspx
Dim level As Long
level = con.BeginTrans
cmd.CommandType = 1 ' adCmdText
If beforeSQL > "" Then
cmd.CommandText = beforeSQL
cmd.ActiveConnection = con
cmd.Execute
End If
' Dim rst As ADODB.Recordset
Dim rst As Object
Set rst = CreateObject("ADODB.Recordset")
With rst
Set .ActiveConnection = con
.Source = "SELECT * FROM " & table
.CursorLocation = 3 ' adUseClient
.LockType = 4 ' adLockBatchOptimistic
.CursorType = 0 ' adOpenForwardOnly
.Open
' Column mappings
Dim tableFields(100) As Integer
Dim rangeFields(100) As Integer
Dim exportFieldsCount As Integer
exportFieldsCount = 0
Dim col As Integer
Dim index As Variant
For col = 0 To .Fields.Count - 1
index = 0
index = Application.Match(.Fields(col).Name, sourcerange.Rows(1), 0)
If Not IsError(index) Then
If index > 0 Then
exportFieldsCount = exportFieldsCount + 1
tableFields(exportFieldsCount) = col
rangeFields(exportFieldsCount) = index
End If
End If
Next
If exportFieldsCount = 0 Then
Err.Raise 513, , "Column mapping mismatch between source and destination tables"
End If
' Fast read of Excel range values to an array
' for further fast work with the array
Dim arr As Variant
arr = sourcerange.Value
' The range data transfer to the Recordset
Dim row As Long
Dim rowCount As Long
rowCount = UBound(arr, 1)
Dim val As Variant
For row = 2 To rowCount
.AddNew
For col = 1 To exportFieldsCount
val = arr(row, rangeFields(col))
If IsEmpty(val) Then
Else
.Fields(tableFields(col)) = val
End If
Next
Next
.UpdateBatch
End With
rst.Close
Set rst = Nothing
If afterSQL > "" Then
cmd.CommandText = afterSQL
cmd.ActiveConnection = con
cmd.Execute
End If
Finalise:
If con.State <> 0 Then
con.CommitTrans
con.Close
End If
Set cmd = Nothing
Set con = Nothing
' Raise appropriate custom errors
Select Case Err.Number
Case -2147217843
Err.Raise 513, , "Issue connecting to SQL server database - please check login credentials"
Case -2147467259
If InStr(1, Err.Description, "Server does not exist") <> 0 Then
Err.Raise 513, , "Could not connect to SQL server, please check you are connected to the local network (in the office or on VPN)"
Else
Err.Raise 513, , "Issue connecting to SQL server database" & vbNewLine & Err.Description
End If
Case -2147217900
If InStr(1, Err.Description, "'PK_XL_Eng_Projects_QuoteRef'") <> 0 Then
Err.Raise 513, , "Quote already uploaded for this QuoteRef and Upload Time, please wait a minute before trying again" & vbNewLine & vbNewLine & Err.Description
Else
Err.Raise Err.Number, , Err.Description
End If
Case 0
' do nothing no error
Case Else
' re raise standard error
Err.Raise Err.Number, , Err.Description
End Select
End Function
Is there a reason why you using SSIS? I think that is best suited for the job.
Anyways, back to your issue. IMEX=1 is not enough. What you need is to check the registry entries
You need set TypeGuessRows and ImportMixedTypes within this registry path (this is for 32-bit office!):
HKEY_LOCAL_MACHINE\SOFTWARE\WOW6432Node\Microsoft\Office\12.0\Access Connectivity Engine\Engines\Excel
TypeGuessRows = 0 (the default is 8)
ImportMixedTypes = Text
What does TypeGuessRows do?
It tries to guess data type based on the number of rows defined. The default values is 8. That means it will check 8 rows to see what data type should be used. If you want to the engine to scan all the rows put 0 there. There is a catch, however, if your spreadsheet large, you could pay heavy performance penalty for such setting.
What does ImportMixedTypes do?
This is where your IMEX setting comes into the game. There are 3 possible values for IMEX setting 0, 1, 2:
0 is Export mode
1 is Import mode
2 is Linked mode (full update capabilities)
Only when setting IMEX=1 the registry value is honored. - with the default setting being ImportMixedTypes=Text. In any other value (0, 2) the value in registry is checked, if it is valid, but it does not influence the outcome. (you will get an error if invalid)
There are two valid values for ImportMixedTypes:
ImportMixedTypes=Text
ImportMixedTypes=Majority Type
The Majority Type is rarely used. What it does it counts type of each column and the majority type is then used for the whole column. The Text type will limit the row size to 255 characters, if you want to use more characters then Majority Type must be used and the majority must use more than 256 characters.
I'm currently using a piece of code to display who is logged into our Access Database. It's a split database, with a backend and multiple frontends. I am currently using this code:
Private Sub btnShowUsers_Click()
'The User List Schema information requires this magic number. For anyone
'who may be interested, this number is called a GUID or Globally Unique
'Identifier - sorry for digressing
Const conUsers = "{947bb102-5d43-11d1-bdbf-00c04fb92675}"
Dim cnn As ADODB.Connection, fld As ADODB.Field, strUser As String
Dim rst As ADODB.Recordset, intUser As Integer, varValue As Variant
Set cnn = CurrentProject.Connection
Set rst = cnn.OpenSchema(Schema:=adSchemaProviderSpecific, SchemaID:=conUsers)
'Set List Box Heading
strUser = "Computer;UserName;Connected?;Suspect?"
Debug.Print rst.GetString
With rst 'fills Recordset (rst) with User List data
Do Until .EOF
intUser = intUser + 1
For Each fld In .Fields
varValue = fld.Value
'Some of the return values are Null-Terminated Strings, if
'so strip them off
If InStr(varValue, vbNullChar) > 0 Then
varValue = Left(varValue, InStr(varValue, vbNullChar) - 1)
End If
strUser = strUser & ";" & varValue
Next
.MoveNext
Loop
End With
Me!txtTotalNumOfUsers = intUser 'Total # of Users
'Set up List Box Parameters
Me!lstUsers.ColumnCount = 4
Me!lstUsers.RowSourceType = "Value List"
Me!lstUsers.ColumnHeads = False
lstUsers.RowSource = strUser 'populate the List Box
'Routine cleanup chores
Set fld = Nothing
Set rst = Nothing
Set cnn = Nothing
End Sub
This works, and it returns the laptop numbers of the users currently using the system, but in the 'Username' column it just says 'ADMIN'. Is there any way to get this to show their Windows username, ie their VBA.Environ("USERNAME")?
No, this is not possible.
This column shows the Access username, same as the Application.CurrentUser() method.
Unless you set up user-level security, add all users to the workgroup file, and start Access with a command-line parameter like
/User %username%
, the user name will always be "Admin".
I have a table with a field containing multi-valuable as shown below:
In the form, I want to let the user enter a NCR_Num in the textbox then using VBA to do some input validation then add it to the "text_Pool" as shown below:
This Text_Pool has the NCR_Num as the control source so if there is a NCR number added or deleted from it, it will automatically update the NCR_Num field.
I am not quite sure how to handle this data type.
In VBA, I cannot obtain the value from the Text_Pool because I think I need to treat it as an array or recordset
Below is an example of me trying the recordset attempt but obviously I am quite confused on what I am doing:
Public Function get_NCR_Num(SCAR_Num As Integer) As Integer()
Dim dbsMain As DAO.Database
Dim rstMain As DAO.Recordset
Dim childRS As Recordset
Dim sSearchField, sCriteria As String
Set dbsMain = CurrentDb
Set rstMain = dbsMain.OpenRecordset("tbl_SCAR", dbOpenDynaset, dbReadOnly)
Set childRS = rstMain!NCR_Num.Value
sSearchField = "[SCAR_Num]"
sCriteria = sSearchField & " = " & [SCAR_Num]
With rstMain
.MoveLast
.FindFirst (sCriteria)
With childRS
Do While (Not .EOF)
MsgBox (childRS!NCR_Num.Value)
.MoveNext
Loop
End With
End With
rstMain.Close
dbsMain.Close
Set rstMain = Nothing
Set dbsMain = Nothing
End Function
Any help will be appreciated!
I misunderstood your question, and have updated the answer with the following code. This should do what you want. Replace the code you have in subroutine 'Command_LinkNCR_Click' with the following.
This will: (a) validate nbr exists; (b) add if not present; (c) remove if present;
WARNING!! This code only addresses the one issue you were trying to overcome. However, it makes an update of the same recordset as you are viewing on the form, so there may be an issue if your form is 'Dirty'.
Give this a try and let me know if you have questions.
Private Sub Command_LinkNCR_Click()
Dim dbs As DAO.Database
Dim rsMain As DAO.Recordset
Dim rsChild As DAO.Recordset
Dim strSQL As String
Dim blnMatch As Boolean
If IsNull(Me.Text_NCR) Or Me.Text_NCR = "" Then
MsgBox "No value entered for NCR_Num", vbOKOnly, "Missing Value"
Exit Sub
End If
blnMatch = False
Set dbs = CurrentDb
' Only need to work on the current record
strSQL = "select * from tbl_SCAR where SCAR_Num = " & Me!SCAR_Num & ";"
Set rsMain = dbs.OpenRecordset(strSQL, dbOpenDynaset)
If rsMain.EOF Then
' Should never happen
Else
Set rsChild = rsMain!NCR_Num.Value
If rsChild.EOF Then ' If no values yet, add this new one
MsgBox "Add item"
Else
Do While Not rsChild.EOF
' See if we have a match...
If Int(rsChild.Fields(0)) = Int(Me.Text_NCR) Then
blnMatch = True
rsChild.Delete ' Delete item
Exit Do
End If
rsChild.MoveNext
Loop
If blnMatch = False Then ' Need to Add it
rsMain.Edit
rsChild.AddNew
rsChild.Fields(0) = Me.Text_NCR
rsChild.Update
rsMain.Update
End If
End If
End If
'rsChild.Close
rsMain.Close
dbs.Close
Set rsMain = Nothing
Set rsChild = Nothing
Set dbs = Nothing
Me.Refresh
End Sub
I have put together a procedure to cycle through a table containing paths to text files and import them into the database.
Reason for procedure:
The reason for this is I am building a back end to many reporting databases that rely on nightly updated text files. Recently they changed the server name and file names for these files, so I'm trying to build something more reliable so I don't have to run through the link table wizard making sure all the data types are exactly the same as before.
Issue:
The issue I have is the With .edit .update isn't acting like I thought it should and updating the field 'Updated' in the table to today's date.
Here is the code. I'm still new to programming, so apologies.
Private Sub ImportAll()
' Loops through table containing paths to text files on network and imports
Dim ID As Integer
Dim netPath As String
Dim netDir As String
Dim netFile As String
Dim localTable As String
Dim activeTable As Boolean
Dim updatedTable As Date
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("Tables")
Do Until rst.EOF
ID = rst.Fields("Table ID").Value
netDir = rst.Fields("Network Location").Value
netFile = rst.Fields("File Name").Value
localTable = rst.Fields("Local Table Name").Value
activeTable = rst.Fields("Active").Value
updatedTable = rst.Fields("Updated").Value
If activeTable = True And updatedTable <> Date Then
If ifTableExists(localTable) Then
On Error GoTo ImportData_Err
CurrentDb.Execute "DELETE * FROM " & localTable, dbFailOnError
netPath = netDir & netFile
DoCmd.TransferText acImportDelim, , localTable, netPath, True, ""
rst.Edit
updatedTable = Date
rst.Update
Else
netPath = netDir & netFile
DoCmd.TransferText acImportDelim, , localTable, netPath, True, ""
With rs
.Edit
.Fields("Updated") = Date
.Update
End With
End If
End If
rst.MoveNext
Loop
rst.Close
Set rst = Nothing
ImportData_Exit:
Exit Sub
ImportData_Err:
MsgBox Error$
Resume ImportData_Exit
End Sub
Thank you.
Where you have
With rs
You meant
With rst
Mistakes such as this can be caught by turning on Option Explicit. Option Explicit means that all variables must be declared.
See here: How do I force VBA/Access to require variables to be defined?
I have an excel sheet with 10 columns with headers. For a column I can have the data as "FF5" or else 620. The sheet name is IODE.
I am trying to import this data from SSIS Import data wizard into the database of table IODE.
On selecting source and destination in the wizard, when I click on PREVIEW DATA in Select Source Tables and Views window, I see the column with 620 as null. After importing this data, the table will have the NULL Instead of 620.
The data type for this column in table is nvarchar(50), I tried many data types like varchar(100), text/..
Only alpha numeric data is accepting.
I didn't write any code for this.. I am just trying to import data from excel sheet to a table.
Please help me in solving this
Thanks
Ramm
Do you mean that you have either FF5 or 620 as the values for that column meaning you have one or the other and nothing else or are there blank fields in that column as well?
I tried reading the excel by using the Excel library reference in VB6.0.
As SSIS Import Wizard treats NUMERIC as NULL when the data is exported to the SQL Table.
This procedure works very well for the data insertion and also for the other database operations.
Private Sub AccessExcelData()
On Error GoTo errHandler
Dim oXLApp As Excel.Application'Declare the object variable
Dim oXLBook As Excel.Workbook
Dim oXLSheet As Excel.worksheet
Dim strFileName As String
Dim lCount As Long
Dim strSCDName As String
Dim strICDName As String
Dim intSource_Index As Integer
Dim strInput_Port As String
Dim strLabel As String
Dim strSDI_CID As String
Dim intWordBitNO As Integer
Dim strFilter_Type As String
Dim strPgroup_Input As String
Dim strParagraph_Input As String
Dim strSQL As String
Dim sConnString As String
Dim cnTest As New ADODB.Connection
Dim rsTempRecordset As New ADODB.Recordset
Dim objDataAccess As New FmmtDataAccess.clsDataAccess
Dim strxmlResult As String
objDataAccess.Intialize ConString
strFileName = App.Path & "\IODE.xls"
sConnString = "Server=uasql\commonsql;Database=accounts;Driver=SQL Server;Trusted_Connection=Yes;DSN=uasql\commonsql"
With cnTest
.ConnectionString = sConnString
.ConnectionTimeout = 4
.CursorLocation = adUseClient
.Open
End With
' Creating part of the excel sheet.
Set oXLApp = CreateObject("Excel.Application")
'Create a new instance of Excel
oXLApp.Visible = False
'Donot Show it to the user
Set oXLBook = oXLApp.Workbooks.Open(strFileName) 'Open an existing workbook
Set oXLSheet = oXLBook.Worksheets(1) 'Work with the first worksheet oXLSheet.Activate
With oXLApp
For lCount = 2 To oXLSheet.UsedRange.Rows.Count
strSCDName = .Cells(lCount, 1).Value
strICDName = .Cells(lCount, 2).Value
intSource_Index = .Cells(lCount, 3).Value
strInput_Port = .Cells(lCount, 4).Value
strLabel = .Cells(lCount, 5).Value
strSDI_CID = .Cells(lCount, 6).Value
intWordBitNO = .Cells(lCount, 7).Value
strFilter_Type = .Cells(lCount, 8).Value
strPgroup_Input = .Cells(lCount, 9).Value
strParagraph_Input = .Cells(lCount, 10).Value
'strSQL = "Insert into XYX () values (strSCDName ..... ) Here any DB related queries can be used
rsTempRecordset.Open strSQL, cnTest, adOpenForwardOnly, adLockReadOnly Next
End With
' Closing part of the excel sheet.
oXLApp.Visible = False 'Donot Show it to the user
Set oXLSheet = Nothing 'Disconnect from all Excel objects (let the user take over)
oXLBook.Close SaveChanges:=False 'Save (and disconnect from) the Workbook
Set oXLBook = Nothing
oXLApp.Quit 'Close (and disconnect from) Excel
Set oXLApp = Nothing
Exit SuberrHandler:
MsgBox Err.Description
Screen.MousePointer = vbNormalEnd Sub
With this procedure the excel records can be read from vb applicatoin and can be inserted into existing table in the SQL database.
Thanks
Ramm