Sub ModuloCargarFotoGestion()
Set cnn = New ADODB.Connection
Set rs = New ADODB.Recordset
Dim cmd As New ADODB.Command
Dim fn As Variant, f As Integer
fn = Application.GetOpenFilename("Text Files (*.txt),*.txt", _
1, "Seleccione Data", , True)
If TypeName(fn) = "Boolean" Then Exit Sub
Call Conectar_Sql
On Error GoTo 0
Application.ScreenUpdating = False
For f = LBound(fn) To UBound(fn)
Debug.Print "Seleccionar Base a Cargar #" & f & ": " & fn(f)
ImportFromTxtToSQL cnn, CStr(fn(f))
Next f
Application.ScreenUpdating = True
Set cnn = Nothing
Exit Sub
DisplayErrorMessage:
MsgBox err.Description, vbExclamation, ThisWorkbook.Name
Resume Next
End Sub
Sub ImportFromTxtToSQL(con As ADODB.Connection, strFullFileName As String)
Set cnn = New ADODB.Connection
Set rs = New ADODB.Recordset
Dim cmd As New ADODB.Command
Dim rngTargetCell As Range
Call Conectar_Sql
'con.Open
Dim wb As Workbook, r As Long, f As Integer
If cnn Is Nothing Then Exit Sub
If cnn.State <> adStateOpen Then Exit Sub
' open the source workbook
On Error GoTo DisplayErrorMessage
Set wb = Workbooks.Open(strFullFileName, False, False)
On Error GoTo 0
If wb Is Nothing Then Exit Sub ' failed to open the workbook
Set rs = New ADODB.Recordset
' open a recordset, all records in a table
On Error GoTo DisplayErrorMessage
Rem query for connect database
rs.Open "SELECT ID,TIPO,MARCACION,FECHA,PRECIO FROM dbo.tabla", cnn, adOpenKeyset, adLockOptimistic, adCmdText
'------------------------------------------------------------------
On Error GoTo 0
If rs.State = adStateOpen Then ' successfully opened the recordset
r = 2 ' the first row containing data in the worksheet
Do While Len(Range("A" & r).Formula) > 0
With rs
.AddNew ' create a new record
' add values to each field in the record
For f = 1 To .Fields.Count
Cells.Offset(r, f).Value = .Fields(f - 1).Name
Next f
Rem -------------------------------------------------------------------------
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
rs.Close
End If
Set rs = Nothing
wb.Close False
Exit Sub
DisplayErrorMessage:
MsgBox err.Description, vbExclamation, ThisWorkbook.Name
Resume Next
End Sub