Hola,tengo muy poco programando pero me gustaria saber si me pueden ayudar con el Error .
Les dejo el codigo:
Sub subedatos(INSTRUCCION)
Dim strConnectString As String
Dim objConnection As ADODB.Connection
Dim strDbPath As String
Dim strTblName As String
Dim strSQL As String
Dim ErrorMessage
'Set database name and DB connection string--------
strDbPath = ThisWorkbook.Path & "\TestDB.accdb"
'==================================================
strConnectString = "Provider = Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & ThisWorkbook.Path & "\INGRESOS.accdb;" & _
"Jet OLEDB:Database Password='****';"
'& _
' "Mode=Share Exclusive"
' strConnectString = "Provider = Microsoft.ACE.OLEDB.12.0; data source=" & strDbPath & _
' ";MS Access;PWD=asdf"
'Connect Database; insert a new table
Set objConnection = New ADODB.Connection
On Error GoTo ErrorMessage
With objConnection
.Open strConnectString
.Execute INSTRUCCION
End With
Set objConnection = Nothing
Exit Sub
ErrorMessage:
MsgBox "OPIS: " & Err.Description & Chr(10) & _
"NUMER: " & Err.Number
Set objConnection = Nothing
End Sub
Sub GenerarInsertInto()
'Definiendo variables
Dim Filas As Integer
Dim Cuenta As Integer
Dim Rango As String
Dim Celda As Range
Dim Valor, Valor1, Valor2 As String
Dim Largo As Integer
Dim RowCursor As Integer
Dim INSTRUCCION As String
Dim Mensaje As String
Set segmento = Worksheets("Datos").Cells(1, 27)
Set ingreso = Worksheets("Datos").Cells(1, 28)
'
On Error GoTo Errores
Filas = Application.WorksheetFunction.CountA(Range("A:A"))
Cuenta = 1
Rango = Application.Transpose(ActiveCell.CurrentRegion.Resize(1).Select)
'
'Extrayendo encabezados
'For Each Celda In Selection
' Valor = Celda.Value
' Valor1 = Valor1 & Valor & ", "
'Next Celda
'Largo = Len(Valor1)
'Valor2 = Left(Valor1, Largo - 2)
'
'Generando Query
With ActiveWorkbook.Sheets("Datos")
If ingreso.Value = "VINOS" Then '*****************SI SE VA A SUBIR LA TABLA DE VINO
For RowCursor = 2 To Filas
INSTRUCCION = "INSERT INTO " & ingreso.Value & " (SEGMENTO,ARTICULO,FAMILIA,GMAYOR,VTABRUTA,DESCUENTO,VTANETA,CANTIDAD,FECHA,INGRESO,ETIQUETA,BOTELLAS,PRESENTACION,LINEA)
VALUES ('" & .Cells(RowCursor, 1) & "', " & _
"'" & .Cells(RowCursor, 2) & "', " & _
"'" & .Cells(RowCursor, 3) & "', " & _
"'" & .Cells(RowCursor, 4) & "', " & _
.Cells(RowCursor, 5) & ", " & _
.Cells(RowCursor, 6) & ", " & _
.Cells(RowCursor, 7) & ", " & _
.Cells(RowCursor, 8) & ", " & _
"#" & .Cells(RowCursor, 9) & "#, " & _
"'" & .Cells(RowCursor, 10) & "', " & _
"'" & .Cells(RowCursor, 11) & "', " & _
.Cells(RowCursor, 12) & ", " & _
"'" & .Cells(RowCursor, 13) & "', " & _
"'" & .Cells(RowCursor, 14) & "')"
' MsgBox (INSTRUCCION)
subedatos INSTRUCCION
Cuenta = Cuenta + 1
Next
ElseIf segmento.Value = "VINO NACIONAL" Then '*****************SI SE VA A SUBIR LA TABLA DE VINO NACIONAL
For RowCursor = 2 To Filas
INSTRUCCION = "INSERT INTO VINONACIONAL (SEGMENTO,ARTICULO,FAMILIA,GMAYOR,VTABRUTA,DESCUENTO,VTANETA,CANTIDAD,FECHA,INGRESO,ETIQUETA,BOTELLAS,PRESENTACION,LINEA,RAZONSOCIAL,MONEDA,TDCAMBIO,TIPO,DOCUMENTO,EJECUTIVO,ORGANIZACIONINV,NUMARTICULO,FECHATIMBRADO)
VALUES ('" & .Cells(RowCursor, 1) & "', " & _
"'" & .Cells(RowCursor, 2) & "', " & _
"'" & .Cells(RowCursor, 3) & "', " & _
"'" & .Cells(RowCursor, 4) & "', " & _
.Cells(RowCursor, 5) & ", " & _
.Cells(RowCursor, 6) & ", " & _
.Cells(RowCursor, 7) & ", " & _
.Cells(RowCursor, 8) & ", " & _
"#" & .Cells(RowCursor, 9) & "#, " & _
"'" & .Cells(RowCursor, 10) & "', " & _
"'" & .Cells(RowCursor, 11) & "', " & _
.Cells(RowCursor, 12) & ", " & _
"'" & .Cells(RowCursor, 13) & "', " & _
"'" & .Cells(RowCursor, 14) & "', " & _
"'" & .Cells(RowCursor, 15) & "', " & _
"'" & .Cells(RowCursor, 16) & "', " & _
.Cells(RowCursor, 17) & ", " & _
"'" & .Cells(RowCursor, 18) & "', " & _
"'" & .Cells(RowCursor, 19) & "', " & _
"'" & .Cells(RowCursor, 20) & "', " & _
"'" & .Cells(RowCursor, 21) & "', " & _
"'" & .Cells(RowCursor, 22) & "', " & _
"#" & .Cells(RowCursor, 23) & "#)"
' MsgBox (INSTRUCCION)
subedatos INSTRUCCION
Cuenta = Cuenta + 1
Next
Else '*****************SI SE VA A SUBIR CUALQUIER OTRA TABLA
For RowCursor = 2 To Filas
INSTRUCCION = "INSERT INTO " & segmento.Value & " (SEGMENTO,ARTICULO,FAMILIA,GMAYOR,VTABRUTA,DESCUENTO,VTANETA,CANTIDAD,FECHA,INGRESO) VALUES ('" & .Cells(RowCursor,
1) & "', " & _
"'" & .Cells(RowCursor, 2) & "', " & _
"'" & .Cells(RowCursor, 3) & "', " & _
"'" & .Cells(RowCursor, 4) & "', " & _
.Cells(RowCursor, 5) & ", " & _
.Cells(RowCursor, 6) & ", " & _
.Cells(RowCursor, 7) & ", " & _
.Cells(RowCursor, 8) & ", " & _
"#" & .Cells(RowCursor, 9) & "#, " & _
"'" & .Cells(RowCursor, 10) & "')"
subedatos INSTRUCCION
Cuenta = Cuenta + 1
Next
End If
End With
'Manejo de errores
Exit Sub
Errores:
MsgBox "Error: " & Err.Description, vbExclamation, "EXCELeINFO"
End Sub
