Related
i am very new to VBA or programmin in general.
Nevertheless, I need to create a code for exporting a csv file.
My issue is that I have several rows with varying lenght in my file.
The file looks as following:
3,6,8
3,9,4,7,8
1
2,4
7,9,4,5,6,8,1
3
My codes gives me:
"3","6","8","","","",""
"3","9","4","7","8","",""
"1","","","","","",""
"2","4","","","","",""
"7","9","4","5","6","8","1"
"3","","","","","",""
I need:
"3","6","8"
"3","9","4","7","8"
"1"
"2","4"
"7","9","4","5","6","8","1"
"3"
Can anyone please help me?
Sub CIF_Katalog_2()
Dim i As Long, lngZeile As Long
Dim myCSVFileName As String
Dim myWB As Workbook
Set myWB = ThisWorkbook
myCSVFileName = myWB.Path & "\" & "CSV Katalog Export_" & VBA.Format(VBA.Now, "dd-MMM-yyyy hh-mm") & ".csv"
lngZeile = Range("A" & Rows.Count).End(xlUp).Row
Open myCSVFileName For Output As #1
For i = 1 To lngZeile
If i = 1 Then
Print #1, Chr(34) & Cells(i, 1).Value & Chr(34)
ElseIf i = 2 Then
Print #1, Chr(34) & Cells(i, 1).Value & Chr(34) & "," & Chr(34) & Cells(i, 2).Value & Chr(34)
Else
Print #1, Chr(34) & Cells(i, 1).Value & Chr(34) & "," & Chr(34) & Cells(i, 2).Value & Chr(34) & "," & Chr(34) & Cells(i, 3).Value & Chr(34) & "," & Chr(34) & Cells(i, 4).Value & Chr(34) & "," & Chr(34) & Cells(i, 5).Value & Chr(34) & "," & Chr(34) & Cells(i, 6).Value & Chr(34) & "," & Chr(34) & Cells(i, 7).Value & Chr(34) & "," & Chr(34) & Cells(i, 8).Value & Chr(34) & "," & Chr(34) & Cells(i, 9).Value & Chr(34) & "," & Chr(34) & Cells(i, 10).Value & Chr(34) & "," & Chr(34) & Cells(i, 11).Value & Chr(34) & "," & Chr(34) & Cells(i, 12).Value & Chr(34) & "," & Chr(34) & Cells(i, 13).Value _
& Chr(34) & "," & Chr(34) & Cells(i, 14).Value & Chr(34) & "," & Chr(34) & Cells(i, 15).Value & Chr(34) & "," & Chr(34) & Cells(i, 16).Value & Chr(34) & "," & Chr(34) & Cells(i, 17).Value & Chr(34) & "," & Chr(34) & Cells(i, 18).Value & Chr(34) & "," & Chr(34) & Cells(i, 19).Value & Chr(34) & "," & Chr(34) & Cells(i, 20).Value & Chr(34) & _
"," & Chr(34) & Cells(i, 21).Value & Chr(34) & "," & Chr(34) & Cells(i, 22).Value & Chr(34) & "," & Chr(34) & Cells(i, 23).Value & Chr(34) & "," & Cells(i, 24).Value & Chr(34) & "," & Chr(34) & Cells(i, 25).Value & Chr(34) & "," & Chr(34) & Cells(i, 26).Value & Chr(34) & "," & Chr(34) & Cells(i, 27).Value & Chr(34) & "," & Chr(34) & Cells(i, 28).Value & Chr(34) & "," & Chr(34) & Cells(i, 29).Value & Chr(34) & "," & Cells(i, 30).Value & "," & Chr(34) & Cells(i, 31).Value & Chr(34) & "," & Chr(34) & Cells(i, 32).Value & Chr(34) & "," & Chr(34) & Cells(i, 33).Value & Chr(34) & "," & Chr(34) & Cells(i, 34).Value & Chr(34) & "," & Chr(34) & Cells(i, 35).Value & Chr(34)
End If
Next i
Close #1
MsgBox "Erledigt"
End Sub
Give this a try... just reusing your code:
Sub CIF_Katalog_2()
Dim i As Long, x As Long, lngZeile As Long
Dim myCSVFileName As String, strTemp As String
Dim myWB As Workbook: Set myWB = ThisWorkbook
myCSVFileName = myWB.Path & "\" & "CSV Katalog Export_" & VBA.Format(VBA.Now, "dd-MMM-yyyy hh-mm") & ".csv"
lngZeile = Range("A" & Rows.Count).End(xlUp).Row
Open myCSVFileName For Output As #1
For i = 1 To lngZeile
For x = 1 To 35
If Cells(i, x) <> "" Then
strTemp = strTemp & Chr(34) & Cells(i, x).Value & Chr(34) & ","
End If
Next x
Print #1, Left(strTemp, Len(strTemp) - 1)
strTemp = ""
Next i
Close #1
MsgBox "Erledigt"
End Sub
A set of data in Excel looking like this:
Test1 12345678 1906 John GY DFS H1C Y
Test2 12345678 1806 Jack GY GQ H1C Y
Test3 12345678 1706 Kate GY GQ H1C Y
Test4 12345678 1606 Sawyer GY GQ H1C
The very last column is to check if data was already loaded to SQL Server.
I have written code to iterate through range and insert values into SQL Table. Within this code, it also checks that last column, if there is a Y, it should skip iteration and go to the next one..
It gives me an error, saying "Else without if".
Sub Connection()
Dim Conn As ADODB.Connection
Dim Command As ADODB.Command
Set Conn = New ADODB.Connection
Set Command = New ADODB.Command
Dim i As Integer
Dim rownumber As Integer
rownumber = Sheets("Sheet1").Range("A1048576").End(xlUp).Row
Conn.ConnectionString = "Provider=SQLOLEDB; Data Source=[Server];Initial Catalog=[DB];User ID=[user];Password=[Password]; Trusted_Connection=no"
Conn.Open
Command.ActiveConnection = Conn
For i = 1 To rownumber 'rows
If ActiveSheet.Cells(i, 8).Value = "Y" Then GoTo NextIteration
Else
Command.CommandText = "INSERT INTO [Database] (" & _
"[Col1], [Col2], [Col3], [Col4], [Col5], [Col6], [Col7])" & _
"VALUES (" & _
"'" & ActiveSheet.Cells(i, 1).Value & "'," & _
"'" & ActiveSheet.Cells(i, 2).Value & "'," & _
"'" & ActiveSheet.Cells(i, 3).Value & "'," & _
"'" & ActiveSheet.Cells(i, 4).Value & "'," & _
"'" & ActiveSheet.Cells(i, 5).Value & "'," & _
"'" & ActiveSheet.Cells(i, 6).Value & "'," & _
"'" & ActiveSheet.Cells(i, 7).Value & "')"
Command.Execute
ActiveSheet.Cells(i, 8).Value = "Y"
End If
Next i
Conn.Close
Set Conn = Nothing
End Sub
I am really struggling to figure out where I went wrong. The code works perfectly fine without checking if "Y" is there...
I appreciate your help.
Try the following
Use Option Explicit at the top to check for variable declarations
Use Long not Integer to avoid potential overflow as you are working with numbers of rows which can exceed capacity of Integer
If statement needs to be broken over several lines to function with Else
Your GoTo referenced a label, NextIteration, which needed adding, You need to verify this is now in the correct place.
Avoid calling your sub connection and use something less ambiguous for the compiler
Public Sub My_Connection()
Dim Conn As ADODB.Connection
Dim Command As ADODB.Command
Set Conn = New ADODB.Connection
Set Command = New ADODB.Command
Dim i As Long
Dim rownumber As Long
rownumber = Worksheets("Sheet1").Range("A1048576").End(xlUp).Row
Conn.ConnectionString = "Provider=SQLOLEDB; Data Source=[Server];Initial Catalog=[DB];User ID=[user];Password=[Password]; Trusted_Connection=no"
Conn.Open
Command.ActiveConnection = Conn
For i = 1 To rownumber 'rows
If ActiveSheet.Cells(i, 8).Value = "Y" Then
GoTo NextIteration
Else
Command.CommandText = "INSERT INTO [Database] (" & _
"[Col1], [Col2], [Col3], [Col4], [Col5], [Col6], [Col7])" & _
"VALUES (" & _
"'" & ActiveSheet.Cells(i, 1).Value & "'," & _
"'" & ActiveSheet.Cells(i, 2).Value & "'," & _
"'" & ActiveSheet.Cells(i, 3).Value & "'," & _
"'" & ActiveSheet.Cells(i, 4).Value & "'," & _
"'" & ActiveSheet.Cells(i, 5).Value & "'," & _
"'" & ActiveSheet.Cells(i, 6).Value & "'," & _
"'" & ActiveSheet.Cells(i, 7).Value & "')"
Command.Execute
ActiveSheet.Cells(i, 8).Value = "Y"
End If
NextIteration:
Next i
Conn.Close
Set Conn = Nothing
End Sub
Add a new line after 'Then' on the first if statement or elses vba implicity closes the if statement.
I'm trying to build a string in Excel VBA that will then be output to a Word file.
The basic strings I'm creating are working fine, but these complex strings are coming in to Word as "False" so I'm not sure what I'm doing wrong.
I'm working with Excel / Word 2013.
Example excel file and word template here:
https://dl.dropboxusercontent.com/u/5611192/Sales%20Package%20-%20Test%20for%20Word%20Proposal.xlsm
https://dl.dropboxusercontent.com/u/5611192/Proposal.docx
The strings that aren't working are built with the following loop:
With Sheet1
For RowCnt = Firstrow To Lastrow
If .Cells(RowCnt, 15).Value = "x" And .Cells(RowCnt, 13).Value = "" Then
strProducts = strProducts & .Cells(RowCnt, 2).Value & " " & .Cells(RowCnt, 8).Value & Chr(11)
ElseIf .Cells(RowCnt, 15).Value = "x" And Cells(RowCnt, 13).Value = "1" Then
strOptions1 = strOptions1 & .Cells(RowCnt, 2).Value & " " & .Cells(RowCnt, 8).Value & Chr(11)
ElseIf .Cells(RowCnt, 15).Value = "x" And .Cells(RowCnt, 13).Value = "2" Then
strOptions2 = strOptions2 & .Cells(RowCnt, 2).Value & " " & .Cells(RowCnt, 8).Value & Chr(11)
ElseIf .Cells(RowCnt, 15).Value = "x" And .Cells(RowCnt, 13).Value = "3" Then
strOptions3 = strOptions3 & .Cells(RowCnt, 2).Value & " " & .Cells(RowCnt, 8).Value & Chr(11)
ElseIf .Cells(RowCnt, 15).Value = "x" And .Cells(RowCnt, 13).Value = "4" Then
strOptions4 = strOptions4 & .Cells(RowCnt, 2).Value & " " & .Cells(RowCnt, 8).Value & Chr(11)
ElseIf .Cells(RowCnt, 15).Value = "x" And .Cells(RowCnt, 13).Value = "5" Then
strOptions5 = strOptions5 & .Cells(RowCnt, 2).Value & " " & .Cells(RowCnt, 8).Value & Chr(11)
ElseIf .Cells(RowCnt, 15).Value = "x" And .Cells(RowCnt, 13).Value = "6" Then
strOptions6 = strOptions6 & .Cells(RowCnt, 2).Value & " " & .Cells(RowCnt, 8).Value & Chr(11)
End If
Next RowCnt
End With
strProducts = strProducts & Chr(11) & Range("A47").Font.Bold = True & Chr(11) & "Purchase, including installation: " & strPrice
strOptions1 = strOptions1 & Chr(11) & Range("A47").Font.Bold = True & Chr(11) & "Purchase, including installation: " & strOption1Price
strOptions2 = strOptions2 & Chr(11) & Range("A47").Font.Bold = True & Chr(11) & "Purchase, including installation: " & strOption2Price
strOptions3 = strOptions3 & Chr(11) & Range("A47").Font.Bold = True & Chr(11) & "Purchase, including installation: " & strOption3Price
strOptions4 = strOptions4 & Chr(11) & Range("A47").Font.Bold = True & Chr(11) & "Purchase, including installation: " & strOption4Price
strOptions5 = strOptions5 & Chr(11) & Range("A47").Font.Bold = True & Chr(11) & "Purchase, including installation: " & strOption5Price
strOptions6 = strOptions6 & Chr(11) & Range("A47").Font.Bold = True & Chr(11) & "Purchase, including installation: " & strOption6Price
The solution
Taking the example of the first string:
strProducts = strProducts & Chr(11) & Range("A47").Font.Bold = True & Chr(11) & "Purchase, including installation: " & strPrice
This part is your issue:
Range("A47").Font.Bold = True
Change this to:
Iif(Range("A47").Font.Bold = True,True,False)
Similarly for the other strings.
The final code
Based on feedback from your comments your code should look like this:
strProducts = strProducts & Chr(11) & Range("A47").Value & Chr(11) & "Purchase, including installation: " & strPrice
Range("A47").Font.Bold = True
I want to insert data to my SQL server database using a datagrid view.I added some data to the grid and need to commit them using a for loop.
Dim i, rowCount As Integer
rowCount = dgOrder.Rows.Count
For i = 0 To (rowCount - 1)
objcon.DoExecute("INSERT INTO OrderMF (ItemType,ItemNm,UnitPrice,Quantity,Discount,TotalValue,FreeItem)VALUES('" _
& dgOrder.Item(i, 1).Value & "','" _
& dgOrder.Item(i, 0).Value & "','" _
& txtOrdNo.Text & "','" _
& dgOrder.Item(i, 3).Value & "','" _
& dgOrder.Item(i, 2).Value & "','" _
& dgOrder.Item(i, 5).Value & "','" _
& dgOrder.Item(i, 4).Value & "','" _
& dgOrder.Item(i, 6).Value & "')")
If objcon.m_Success = "0" Then
MsgBox("Record Added Successfully", MsgBoxStyle.Information, "ROBBIALAK")
Call ClearFields1()
cmdOrder.Enabled = False
End If
Next
This is my code for the button click.But it dosen't work for me.it is getting a exception saying "Index was out of range.Must be non negative and less than the size of the collection,parameter name:index" .In this code dgorder is my datagridview name and I used a method call DoExecute to Execute the SQL String.please help me to get through this problem.
Against intuition, it is .Item(columnIndex, rowIndex) not .Item(rowIndex, columnIndex). Luckily there is also .Item(columnName, rowIndex) and I advise you to use that, because that would increase readability a lot. So I think you should change
dgOrder.Item(i, 1).Value
to
dgOrder.Item("ItemType", i).Value
(if column name is "ItemType") and so on.
Also, it seems that you are trying to insert more values than there are columns specified
ItemType,
ItemNm,
UnitPrice,
Quantity,
Discount,
TotalValue,
FreeItem - 7 columns:
dgOrder.Item(i, 1).Value & "','" _
& dgOrder.Item(i, 0).Value & "','" _
& txtOrdNo.Text & "','" _
& dgOrder.Item(i, 3).Value & "','" _
& dgOrder.Item(i, 2).Value & "','" _
& dgOrder.Item(i, 5).Value & "','" _
& dgOrder.Item(i, 4).Value & "','" _
& dgOrder.Item(i, 6).Value & "' - 8 values
I am new to Vba, hope someone will solve my problem. I am trying to update data present in my spreadsheet. Actually i have 20,000 records, each record has around 74 columns. So updating them record by record by using ADO taking so much of time. Is there any alternative approach to update those records in single shot. Any help would be appreciated greatly.
Currently my code is.
Sub InitialExport()
On Error GoTo ErrHandler
Dim con As New ADODB.Connection
Dim Query As String
Dim EffectedRecs As Long
Dim i As Integer
ServerName = "192.178.78.36"
'Setting ConnectionString
con.ConnectionString = "Provider=SQLOLEDB; " & _
"Data Source=" & ServerName & "; " & _
"Initial Catalog=AppEmp;" & _
"User ID=sa; Password=admin08; "
'Setting provider Name
con.Provider = "Microsoft.JET.OLEDB.12.0"
'Opening connection
con.Open
With ThisWorkbook.Sheets("Export")
For i = 3 To ThisWorkbook.Sheets("Export").Range("B65536").End(xlUp).Row
'---------------------->
EmpId = .Range("B" & i).Value 'Emp Code-varchar
C = .Range("C" & i).Value 'Emp Name-varchar
D = .Range("D" & i).Value
E = .Range("E" & i).Value
F = .Range("F" & i).Value
G = .Range("G" & i).Value
H = .Range("H" & i).Value
II = .Range("I" & i).Value
JJ = .Range("J" & i).Value
k = .Range("K" & i).Value
l = .Range("L" & i).Value
M = .Range("M" & i).Value
N = CheckNull(.Range("N" & i).Value)
O = CheckNull(.Range("O" & i).Value)
P = CheckNull(.Range("P" & i).Value)
Q = CheckNull(.Range("Q" & i).Value)
R = CheckNull(.Range("R" & i).Value)
S = .Range("S" & i).Value
T = .Range("T" & i).Value
U = .Range("U" & i).Value
v = .Range("V" & i).Value
W = .Range("W" & i).Value
X = CheckNull(.Range("X" & i).Value)
Y = .Range("Y" & i).Value
Z = .Range("Z" & i).Value
AA = CheckNull(.Range("AA" & i).Value)
AB = .Range("AB" & i).Value
AC = CheckNull(.Range("AC" & i).Value)
AD = CheckNull(.Range("AD" & i).Value)
AE = CheckNull(.Range("AE" & i).Value)
AF = CheckNull(.Range("AF" & i).Value)
AG = .Range("AG" & i).Value
AH = CheckNull(.Range("AH" & i).Value)
AI = CheckNull(.Range("AI" & i).Value)
AJ = CheckNull(.Range("AJ" & i).Value)
AK = CheckNull(.Range("AK" & i).Value)
AL = CheckNull(.Range("AL" & i).Value)
AM = CheckNull(.Range("AM" & i).Value)
AN = CheckNull(.Range("AN" & i).Value)
AO = CheckNull(.Range("AO" & i).Value)
AP = CheckNull(.Range("AP" & i).Value)
AQ = CheckNull(.Range("AQ" & i).Value)
AR = CheckNull(.Range("AR" & i).Value)
aAS = CheckNull(.Range("AS" & i).Value)
AT = .Range("AT" & i).Value
AU = CheckNull(.Range("AU" & i).Value)
AV = CheckNull(.Range("AV" & i).Value)
AW = CheckNull(.Range("AW" & i).Value)
AX = CheckNull(.Range("AX" & i).Value)
AY = CheckNull(.Range("AY" & i).Value)
AZ = CheckNull(.Range("AZ" & i).Value)
BA = CheckNull(.Range("BA" & i).Value)
BB = CheckNull(.Range("BB" & i).Value)
BC = CheckNull(.Range("BC" & i).Value)
BD = CheckNull(.Range("BD" & i).Value)
BE = .Range("BE" & i).Value
BF = .Range("BF" & i).Value
BG = CheckNull(.Range("BG" & i).Value)
BH = .Range("BH" & i).Value
BI = .Range("BI" & i).Value
BJ = CheckNull(.Range("BJ" & i).Value)
BK = CheckNull(.Range("BK" & i).Value)
BL = CheckNull(.Range("BL" & i).Value)
BM = .Range("BM" & i).Value
BN = .Range("BN" & i).Value
Query = "Exec HRApp_P_AddEmpData '" & EmpId & "','" & C & "','" & D & "','" & E & "','" & F & "','" & G & "','" & H & "','" & II & "','" & JJ & "','" & k & "','" & l & "','" & M & "'," & N & "," & O & "," & P & "," & Q & "," & R & ",'" & S & "','" & T & "','" & U & "','" & v & "','" & W & "'," & X & ",'" & Y & "','" & Z & "'," & AA & ",'" & AB & "'," & AC & "," & AD & "," & AE & "," & AF & ",'" & AG & "'," & AH & "," & AI & "," & AJ & "," & AK & ",'" & AL & "'," & AM & "," & AN & "," & AO & "," & AP & "," & AQ & "," & AR & "," & aAS & ",'" & AT & "'," & AU & "," & AV & "," & AW & "," & AX & "," & AY & "," & AZ & "," & BA & "," & BB & "," & BC & "," & BD & ",'" & BE & "','" & BF & "'," & BG & ",'" & BH & "','" & BI & "'," & BJ & "," & BK & "," & BL & ",'" & BM & "','" & BN & "'"
con.Execute Query
Next
End With
con.Close
Set con = Nothing
Exit Sub
ErrHandler: 'MsgBox "The Not able ta Save Data"
Set con = Nothing
End Sub
The above code is working fine. But it is taking more time to update data.:-(
Now my code became like this
Private Sub Worksheet_Activate()
Dim adoConn As New ADODB.Connection
Dim adoRS As New ADODB.Recordset
Dim sQuery As String
Dim EffectedRecs As Long
Dim sFields As String
Dim sValues As String
Dim iRow As Integer
Dim iField As Integer
ServerName = "193.128.125.14"
con_Str = "Provider=SQLOLEDB; " & _
"Data Source=" & ServerName & "; " & _
"Initial Catalog=DB_At&T;" & _
"User ID=sa; Password=ad28; "
sQuery = "select * from Currency where 1=2"
sValues = ""
With adoConn
.ConnectionString = con_Str
.Provider = "Microsoft.JET.OLEDB.12.0"
.CursorLocation = adUseClient
.Open
End With
With adoRS
.ActiveConnection = adoConn
.CursorLocation = adUseClient
.LockType = adLockBatchOptimistic
.CursorType = adOpenKeyset ' adOpenDynamic
.Source = sQuery
.Open
End With
With ThisWorkbook.Sheets("Export")
For iRow = 3 To ThisWorkbook.Sheets("Export").Range("B65536").End(xlUp).Row
For iField = 0 To adoRS.Fields.Count - 1
sFields = sFields & "," & adoRS.Fields(iField).Name
Next
sValues = sValues & "," & .Range("A" & iRow).Value
sValues = sValues & "," & .Range("B" & iRow).Value
sValues = sValues & "," & .Range("C" & iRow).Value
sValues = sValues & "," & .Range("D" & iRow).Value
sFields = Right(sFields, Len(sFields) - 1) 'Removing ,
sValues = Right(sValues, Len(sValues) - 1) 'Removing ,
adoRS.AddNew FieldList = sFields, Values:=sValues
Next
End With
adoRS.UpdateBatch adAffectAllChapters
adoRS.Close
adoConn.Close
End Sub
you could try this:
Sub InitialExport()
On Error GoTo ErrHandler
'
Dim adoConn As New ADODB.Connection
Dim adoRS As ADODB.Recordset
'
Dim sQuery As String
Dim EffectedRecs As Long
Dim sFields As String
Dim sValues As String
'
Dim iRow As Integer
Dim iField As Integer
'
ServerName = SERVER_NAME
'
sQuery="SELECT * from tableName where 1 =2" ' get an empty recordset!
'
'Set the connection and open
with adoConn
.ConnectionString = CONNECTION_STRING
.Provider = "Microsoft.JET.OLEDB.12.0"
.cursorlocation=aduseclient
.Open
end with
'
' set the Recordset and open
With adoRS
.activeconnection=adoconn
.CursorLocation = adUseClient
.LockType = adLockBatchOptimistic
.CursorType = adopenkeyset ' adOpenDynamic
.Source = sQuery
.Open
End With
'
' now get the data into the recordset
With ThisWorkbook.Sheets("Export")
For iRow = 3 To ThisWorkbook.Sheets("Export").Range("B65536").End(xlUp).Row
' here loop through all the columns
For iField = 0 To adoRS.Fields.Count - 1
' adding the column names to the Variable sFields
sFields = sFields & "," & adoRS.Fields(iField).Name
'
' adding the values from the worksheet for this row
sValues = sValues & ", " & .Cells(iRow, iField).Text
Next
'
' add a new record with the fields and values
adoRS.AddNew FieldList:=sFields, Values:=sValues
'
Next
'
' update all the rows in one step
adoRS.UpdateBatch adAffectAllChapters ' update them all in one step!
'
End Sub
just change tablename in the query to the correct table and make sure the columns in the worksheet are in the same order and datatype as the columns in the table
for ADO Recordset help see:
MSDN Library - ADO Recordset, AddNew method
and
MSDN Library - ADO Recordset, UpdateBatch
and
W3Schools
I hope that get's you started!
Philip
Another option could be uploading your entire Excel Sheet as a csv file directly into the server using BulkInsert.
The Sql code might look as simple as this:
BULK INSERT [DB].[dbo].[Importa_Aux] FROM '\\share\filename.csv' WITH ( FIELDTERMINATOR = ',' , ROWTERMINATOR = '\n' , FIRSTROW = 2 )
Then simply work your data updates in SqlServer.