Using VBScript, I create a recordset from a SQL query through and ADO connection object. I need to be able to write the field names and the largest field length to a text file, essentially as a two dimensional array, in the format of FieldName|FieldLength with a carriage return delimiter, example:
Matter Number|x(13)
Description|x(92)
Due Date|x(10)
Whilst I am able to loop through the Columns and write out the field names, I cannot solve the issue of Field Length. Code as follows:
Set objColNames = CreateObject("Scripting.FileSystemObject").OpenTextFile(LF14,2,true)
For i=0 To LF06 -1
objColNames.Write(Recordset.Fields(i).Name & "|x(" & Recordset.Fields(i).ActualSize & ")" & vbCrLf)
Next
in this instance it only writes the current selected Field Length.
If I understand the question correctly (I'm not certain I do)....
If you change your SQL statement you only need to return one record.
Select Max(Len([Matter Number])) as [Matter Number],
Max(Len([Description])) As Description, Max(Len([Due Date])) As [Due Date] FROM TableName
This will return the maximum length of each field. Then construct your output from there.
To get an extrema item (largest, smallest, ...) of a collection you need a loop over all elements that checks the current element's value against the known 'extrema so far':
>> a = Array(1, 3, 2)
>> x = a(0)
>> For i = 1 To UBound(a)
>> If a(i) > x Then
>> x = a(i)
>> End If
>> Next
>> WScript.Echo x
>>
3
After a little more research and testing I solved the issue by creating a dictionary based on the recordset field (column) count, then iterating through each item and evaluating the length of each field:
Dim Connection
Dim Recordset
Set Connection = CreateObject("ADODB.Connection")
Set Recordset = CreateObject("ADODB.Recordset")
Connection.Open LF08
Recordset.Open LF05,Connection
LF06=Recordset.Fields.Count
Set d = CreateObject("Scripting.Dictionary")
Set objColNames = CreateObject("Scripting.FileSystemObject").OpenTextFile(LF14,2,true)
For i=0 to LF06 -1
d.Add i, 0
Next
Dim aTable1Values
aTable1Values=Recordset.GetRows()
Set objFileToWrite = CreateObject("Scripting.FileSystemObject").OpenTextFile(LF07,2,true)
Dim iRowLoop, iColLoop
For iRowLoop = 0 to UBound(aTable1Values, 2)
For iColLoop = 0 to UBound(aTable1Values, 1)
If d.item(iColLoop) < Len(aTable1Values(iColLoop, iRowLoop)) Then
d.item(iColLoop) = Len(aTable1Values(iColLoop, iRowLoop))
End If
If IsNull(aTable1Values(iColLoop, iRowLoop)) Then
objFileToWrite.Write("")
Else
objFileToWrite.Write(aTable1Values(iColLoop, iRowLoop))
End If
If iColLoop <> UBound(aTable1Values, 1) Then
objFileToWrite.Write("|")
End If
next 'iColLoop
objFileToWrite.Write(vbCrLf)
Next 'iRowLoop
For i=0 to LF06 -1
d.item(i) = d.item(i) + 3
objColNames.Write(Recordset.Fields(i).Name & "|x(" & d.item(i) & ")" & vbCrLf)
Next
I then have two text files, one with the field names and lengths, the other with the query results. Using this I can then create a two dimensional array in the CMS (VisualFiles) from the results.
Related
I have some ComboBoxes on my FORM. One of them have items as a result of SQL request from field PG (cbPG.RowSource = "SELECT DISTINCT W_report.PG FROM W_report WHERE ......) The size of the field is byte.
After reqest
User can select one of the variant or can list several comma-separated (2,4,5,7,11,13).
Correct value
The resulting ComboBox.value is used in a procedure similar to selecting pages for printing. Everything works correctly until changes are made to the event handler of cbPG. Then the values are automatically rounded (if one comma)
wrong value
or an error "The entered value is not appropriate for this field" occurs (if a few commas) and I have to copy cbPG from the backup because I can't find a property that changes format of cbPG.value to byte.
Here is part of program that use my ComboBox
Public Function MnogoListov(str As String) As String
Dim i, j As Integer
Dim res As String
Dim listArr() As String
res = ""
ReDim listArr(Len(str)) As String
For i = 1 To Len(str)
If Mid(str, i, 1) <> "," And Mid(str, i, 1) <> "." Then
listArr(j) = listArr(j) & Mid(str, i, 1)
Else
j = j + 1
End If
Next
For i = 0 To j
If i = 0 Then
res = listArr(i)
Else
res = res & " OR W_report.PG = " & listArr(i) End If
Next
MnogoListov = res
End Function
You can't do that. A combobox is for selecting one value from several.
So, either use a multi-select listbox or a simple textbox where you - similar to selecting pages for printing - parse the inputted values to obtain the sequence (list) of items (pages).
Context : I want to import in a PostgreSQL database some data that is in a Excel spreadsheet.
To do so, I have established in VBA a connection with the database, and now, I want to carry out one INSERT SQL query for each of the rows, e.g.
INSERT INTO mytable VALUES ('a','b',32,'d',17.2);
if we suppose a pgSQL table with 5 columns, 2 of them being numerical.
Using an array and the VBA join function I already figured out how to take a given line of the Excel table and convert it into a list in which every item is quoted, e.g.
('a','b','32','d','17.2');
from which I can easily write an SQL query.
The drawback of having all the items quoted is that upon inserting, the postgreSQL server will have to convert the numerical values that have been passed as strings back to numerical values again. I fear that this could impact performance, especially in situations where 50000+ lines need to be processed.
The question : In this context, I would like to find a solution to put quotes only on non-numerical values when converting a VBA array into a comma-separated list without using a For loop on the columns, which could affect performance as well.
My current VBA code to convert my horizontal Excel range into such a list is:
myArray = Application.Transpose(Application.Transpose(myRange.Value))
myList = "('" & Join(myArray, "','") & "')"
(in the above example, myArray would be a VBA array containing the values ("a","b",32,"d",17.2)).
Take a few milli-seconds to convert the array before the Join.
Dim myarray As Variant, mylist As String, i As Long
myarray = Application.Transpose(Application.Transpose(Range("a1:f1").Value2))
For i = LBound(myarray) To UBound(myarray)
If Not IsNumeric(myarray(i)) Then _
myarray(i) = Chr(39) & Trim(myarray(i)) & Chr(39)
Next i
mylist = "(" & Join(myarray, Chr(44)) & ")"
Debug.Print mylist
Use a loop with a buffer to build the SQL. You won't notice a difference on the performance. You'll also have more control over the type and you'll be able to escape the quote in case a string contains one:
Sub Test()
Dim data()
data = [{ "a",1 ; "b",2 }]
Debug.Print ToSqlInsert("MyTable (Col1, Col2)", data)
End Sub
Public Function ToSqlInsert(target As String, data()) As String
Dim sb() As String, n As Long, r As Long, c As Long
ReDim sb(0 To UBound(data, 1) * UBound(data, 2) * 2)
sb(n) = "INSERT INTO " & target & " VALUES ("
n = n + 1
For r = 1 To UBound(data, 1)
For c = 1 To UBound(data, 2)
If c > 1 Then sb(n - 1) = ","
Select Case VBA.VarType(data(r, c))
Case vbString: sb(n) = "'" & Replace$(data(r, c), "'", "''") & "'"
Case vbDate: sb(n) = Int((data(r, c) - #1/1/1970#) * 86400) ' to epoche '
Case vbEmpty: sb(n) = "NULL"
Case Else: sb(n) = data(r, c)
End Select
n = n + 2
Next
sb(n - 1) = "),("
Next
sb(n - 1) = ");"
ToSqlInsert = Join$(sb, Empty)
End Function
I have a large range that I need to find all numbers that is between four and six digits long.
I know I can use regex for this but I don't want to loop each cell and check them all.
What I need is kind of selecting the range copy and paste in notepad and copy back to a variable.
This way I can regex the variable and find all matches at once.
I don't need to know where the number was found, I just need the numbers.
Is there any way to copy the values to a string like this?
Dim text As String
text = ActiveSheet.Range("C9:IQ56").Value
is not compatible datatypes.
If I use variant I get an array of the columns and cells.
My attempt to join the array is not successful either.
text = ActiveSheet.Range("C9:IQ56").Value
textstring = ""
For i = 1 To UBound(text, 1)
textstring = textstring & " " & Join(text(i))
Next i
Any help with this?
use Application Index to do each row at a time:
text = ActiveSheet.Range("C9:IQ56").Value
textstring = ""
For i = 1 To UBound(text, 1)
textstring = textstring & " " & Join(application.Index(text,i,0))
Next i
There are two problems in your code, the declaration and the dimensions of the variable. Here is what you can do:
Dim Text() As Variant
Text = ActiveSheet.Range("C9:IQ56").Value
textstring = ""
For i = 1 To UBound(Text, 1)
For j = 1 To UBound(Text, 2)
textstring = textstring & " " & Text(i, j)
Next j
Next i
Similar approach with delimiters concatenating row strings after loop
Added a Timer and the feature to use separators (delimiters) as well for rows (e.g. "|") as for columns (e.g. ","). Furthermore I demonstrate a way to join all row strings at once after loop via Application.Transpose() just for the sake of the art, though this isn't faster nor slower than #Scott Craner 's valid solution :+).
Code
Sub arr2txt()
Const SEPROWS As String = "|" ' << change to space or any other separator/delimiter
Const SEPCOLS As String = "," ' << change to space or any other separator/delimiter
Dim v
Dim textstring As String, i As Long
Dim t As Double: t = Timer ' stop watch
v = ActiveSheet.Range("C2:E2000").Value ' get data into 1-based 2-dim datafield array
For i = 1 To UBound(v, 1)
v(i, 1) = Join(Application.Index(v, i, 0), SEPCOLS)
Next i
textstring = Join(Application.Transpose(Application.Index(v, 0, 1)), SEPROWS)
Debug.Print Format(Timer - t, "0.00 seconds needed")
End Sub
I have the following data set, which contains duplicates.
values:
2880CR-20.36KX53305DECOAK2015
F05572-CN48517OCTOAK2016
F05572-CN48517DECOAK2016
F05572-CN48517NOVOAK2015
F05572-CN48517NOVOAK2015(duplicate)
F05572-CN48517DECOAK2015
F05573-CN48517JANOAK2016
F05573-CN48517FEBOAK2016
F05573-CN48517JANOAK2015
F05573-CN48517FEBOAK2015
F05573-CN48517MAROAK2015
F05573-CN48517APROAK2015
F05573-CN48517APROAK2015(duplicate)
I am trying to create a macro that will look at the values in column A, from A2:A (count of rows in column), and return a list of the duplicate values contained in the string declared "strMyDupList". Basically, if there is atleast 1 duplicate, the msgbox will pop up and the new sheet created with the columns address and values and I am trying to list out all the values seperated my a comma VERTICALLY, instead of horizontally across the sheet. so like:
Address value
$A$5 F05572-CN48517NOVOAK2015
$A$13 F05573-CN48517APROAK2015
my code is :
If strMyDupList <> "" Then
MsgBox "The following entries have been used more than once:" & vbNewLine & strMyDupList
Worksheets.Add.name = name
Worksheets(name).Range("A1").Value = "Location"
Worksheets(name).Range("B1").Value = "Value"
' Worksheets(name).Range("A2:C2").Value = Split(strMyDupList, ",")
Worksheets(name).Range("B4:B6") = Split(Application.WorksheetFunction.Transpose(strMyDupList), ",")
The results are that I am able to get the values tranposed from horizontal to vertical, however, with this code, it is only returning the FIRST VALUE in the list of values in the string, so it's returning:
Address value
$A$5 F05572-CN48517NOVOAK2015
$A$5 F05572-CN48517NOVOAK2015 (should be F05573-CN48517APROAK2015)
I've seen the UBound with Resize could work but I have no idea how the syntax works or is used. Can someone assist?
Thank you
Here is a complete example of how to leave duplicates out of your information.
Essentially, it sorts all of your information. Therefore, when you sort you'll get the consecutive value which would be itself if it was a dupe.
It uses a .NET feature, System.Collections.ArrayList, that was in 2.0 & 3.5 so that has to be installed on your machine. Usually it already is but it may not be. You can turn it on through Programs & Features.
Sub StringArrayDupeChecker()
Dim var As Variant
Dim holder As String
Dim strMyList() As String
Dim myDupeData As Variant
Dim str As String
str = "one,two,three,three,three,four,five,five"
strMyList = Split(str, ",")
holder = ""
Set var = CreateObject("System.Collections.ArrayList")
Set myDupeData = CreateObject("System.Collections.ArrayList")
For Each i In strMyList
var.Add (i)
Next i
var.Sort
For Each j In var
If Not j = holder Then
'do your stuff
str = "notDupe"
Else
myDupeData.Add(j)
End If
holder = j
Next j
End Sub
I am writing VBA code for an Excel workbook. I would like to be able to open a connection with an Access database, and then import a txt file (pipe delimited) and create a new table in the database from this txt file. I have searched everywhere but to no avail. I have only been able to find VBA code that will accomplish this from within Access itself, rather than from Excel. Please help! Thank you
Google "Open access database from excel VBA" and you'll find lots of resources. Here's the general idea though:
Dim db As Access.Application
Public Sub OpenDB()
Set db = New Access.Application
db.OpenCurrentDatabase "C:\My Documents\db2.mdb"
db.Application.Visible = True
End Sub
You can also use a data access technology like ODBC or ADODB. I'd look into those if you're planning more extensive functionality. Good luck!
I had to do this exact same problem. You have a large problem presented in a small question here, but here is my solution to the hardest hurdle. You first parse each line of the text file into an array:
Function ParseLineEntry(LineEntry As String) As Variant
'Take a text file string and parse it into individual elements in an array.
Dim NumFields As Integer, LastFieldStart As Integer
Dim LineFieldArray() As Variant
Dim i As Long, j As Long
'Determine how many delimitations there are. My data always had the format
'data1|data2|data3|...|dataN|, so there was always at least one field.
NumFields = 0
For I = 1 To Len(LineEntry)
If Mid(LineEntry, i, 1) = "|" Then NumFields = NumFields + 1
Next i
ReDim LineFieldArray(1 To NumFields)
'Parse out each element from the string and assign it into the appropriate array value
LastFieldStart = 1
For i = 1 to NumFields
For j = LastFieldStart To Len(LineEntry)
If Mid(LineEntry, j , 1) = "|" Then
LineFieldArray(i) = Mid(LineEntry, LastFieldStart, j - LastFieldStart)
LastFieldStart = j + 1
Exit For
End If
Next j
Next i
ParseLineEntry = LineFieldArray
End Function
You then use another routine to add the connection in (I am using ADODB). My format for entries was TableName|Field1Value|Field2Value|...|FieldNValue|:
Dim InsertDataCommand as String
'LineArray = array populated by ParseLineEntry
InsertDataCommand = "INSERT INTO " & LineArray(1) & " VALUES ("
For i = 2 To UBound(LineArray)
If i = UBound(LineArray) Then
InsertDataCommand = InsertDataCommand & "'" & LineArray(i) & "'" & ")"
Else
InsertDataCommand = InsertDataCommand & LineArray(i) & ", "
End If
Next i
Just keep in mind that you will have to build some case handling into this. For example, if you have an empty value (e.g. Val1|Val2||Val4) and it is a string, you can enter "" which will already be in the ParseLineEntry array. However, if you are entering this into a number column it will fail on you, you have to insert "Null" instead inside the string. Also, if you are adding any strings with an apostrophe, you will have to change it to a ''. In sum, I had to go through my lines character by character to find these issues, but the concept is demonstrated.
I built the table programmatically too using the same parsing function, but of this .csv format: TableName|Field1Name|Field1Type|Field1Size|...|.
Again, this is a big problem you are tackling, but I hope this answer helps you with the less straight forward parts.