pasar datos de excel a la tabla acces desde vb6

Colapsar
X
  • Filtrar
  • Tiempo
  • Mostrar
Limpiar todos
nuevos mensajes

  • pasar datos de excel a la tabla acces desde vb6

    saludos. tengo una consulta y un dilema, les explico. tengo mi base de datos en acces ya llena, pero me pasan archivos en excel con datos de una columnas que tengo q agregarle a los registros ya existentes en mi base de datos. mi base de datos principal tiene mas de 70 columnas pero voy a darles un ejemplo:

    NOMENCLATURA nombre apellido cedula condicion estado etc etc SERIAL

    23180299302 jesus trillo 15.222.555 3 5 8 5 71015222555


    mas o menos esa es mi base de datos en acces, en excel me pasan los datos completos de la persona y el SERIAL que es el que necesito cargarle a la base de datos para no hacerlo manual ya q es muy tedioso, el campo que es único es la NOMENCLATURA pero donde se compararía por excel es la cédula, pero no tengo ni idea de como hacer el bucle para q me compare los datos y si lo consigue que me agregue el serial
    Última edición por jtrillo; 26-03-2017, 05:31 AM.

  • #2
    Abres Excel

    Código:
        Dim nRow As Integer, nCol1 As Integer, nCol2 As Integer, cStr1 As String, cStr2 As String
        nRow=1
        nCol1 = * (aquí pones el número de columna en que esté la célula)
        nCol2 = * (aquí pones el número de columna en que esté el SERIAL)
    
        
        Do
    OtraFila:
            cStr1 = Trim$(excel_sheet.Cells(nRow, nCol1))
            If Len(cStr1) <> 0 Then
    
               cStr2 = Trim$(excel_sheet.Cells(nRow, nCol2))
               db.Execute "UPDATE  TuTabla Set SERIAL='" & cStr2 & "' WHERE NOMENCLATURA = '" & cStr1 &"'"
    
               nRow = nRow + 1
               GoTo OtraFila
    
            End If
            Exit Do
        Loop
    - Cierras Excel

    Espero no haber metido garrafales..., porque lo estoy redactando "al aire..." Ojalá te sirva.
    José María Movilla Cuadrado
    ______________________
    Normas del foro
    www.foro.vb-mundo.com
    www.vb-mundo.com

    Comentario


    • #3
      Originalmente escrito por J_M_Movilla Ver mensaje
      Abres Excel

      Código:
       Dim nRow As Integer, nCol1 As Integer, nCol2 As Integer, cStr1 As String, cStr2 As String
      nRow=1
      nCol1 = * (aquí pones el número de columna en que esté la célula)
      nCol2 = * (aquí pones el número de columna en que esté el SERIAL)
      
      
      Do
      OtraFila:
      cStr1 = Trim$(excel_sheet.Cells(nRow, nCol1))
      If Len(cStr1) <> 0 Then
      
      cStr2 = Trim$(excel_sheet.Cells(nRow, nCol2))
      db.Execute "UPDATE TuTabla Set SERIAL='" & cStr2 & "' WHERE NOMENCLATURA = '" & cStr1 &"'"
      
      nRow = nRow + 1
      GoTo OtraFila
      
      End If
      Exit Do
      Loop
      - Cierras Excel

      Espero no haber metido garrafales..., porque lo estoy redactando "al aire..." Ojalá te sirva.

      Gracias JM Movilla ya me pongo analizar y a programar. como siempre gracias. Cualquier duda o si lo logro hacer lo hago saber por aca mismo

      Comentario


      • #4
        Originalmente escrito por J_M_Movilla Ver mensaje
        Abres Excel

        Código:
         Dim nRow As Integer, nCol1 As Integer, nCol2 As Integer, cStr1 As String, cStr2 As String
        nRow=1
        nCol1 = * (aquí pones el número de columna en que esté la célula)
        nCol2 = * (aquí pones el número de columna en que esté el SERIAL)
        
        
        Do
        OtraFila:
        cStr1 = Trim$(excel_sheet.Cells(nRow, nCol1))
        If Len(cStr1) <> 0 Then
        
        cStr2 = Trim$(excel_sheet.Cells(nRow, nCol2))
        db.Execute "UPDATE TuTabla Set SERIAL='" & cStr2 & "' WHERE NOMENCLATURA = '" & cStr1 &"'"
        
        nRow = nRow + 1
        GoTo OtraFila
        
        End If
        Exit Do
        Loop
        - Cierras Excel

        Espero no haber metido garrafales..., porque lo estoy redactando "al aire..." Ojalá te sirva.


        saludos aqui me sale un error de VARIABLE NO DEFINODA se la coloque en ROJO y cuando me dice en nCol1 ese asterisco va con el numero de la columna?? algo asi

        nCol1 = * 3
        cCol2 = * 2

        pero mejor le muestro lo que tengo

        Última edición por jtrillo; 27-03-2017, 02:29 AM.

        Comentario


        • #5
          Código:
          Private Sub cmdImportar_Click()
          
          Dim LibroTrabajo As Object
          Dim filename As String
          
          Dim xlApp As Object
          Dim xlHoja As Object
          Dim xlLibro As Object
          Dim Excel_sheet As Worksheet
          Dim nRow As Integer, nCol1 As Integer, nCol2 As Integer, cStr1 As String, cStr2 As String
          
          
          'Muestra el cuadro de dialogo Abrir con un filtro de 3 tipos
          'apuntando al directorio por defecto del explorador:
          
          filename = OpenFile(Me.hwnd, "Archivo Excel|*.xlsx", "Abrir documento", "%desktop%")
          
          
          If filename = vbNullString Then
          
                   'se cierra la busqueda y vuelve al form...
          Else
          
             'si se abrio el archivo excel, procede confirmarnoslo con un msgbox y luego puedes hacer cualquier cosa..
                  Set LibroTrabajo = GetObject(filename) 'aqui me tira un error de variable de tipo object o variable de tipo with no esta establecida
                  MsgBox filename & Chr(13) & Chr(13) & "Cargado correctamente....!"
          
          Set xlLibro = xlApp.Workbooks.Open(filename)
          Set xlHoja = xlApp.Worksheets("FORMATO")
          
          
          nRow = 1
          nCol1 = 3
          nCol2 = 2
          
          
                    Do
          OtraFila:
               cStr1 = Trim$(Excel_sheet.Cells(nRow, nCol1))
                If Len(cStr1) <> 0 Then
          
                BASE.Execute "UPDATE INAVI Set SERIAL='" & cStr2 & "' WHERE Cedula = '" & cStr1 & "'"
          
               nRow = nRow + 1
             GoTo OtraFila
          
          End If
          Exit Do
          Loop
          
          
          End If
          
          
          End Sub

          Comentario


          • #6
            Perdona; se me pasó el indicarte que excel_sheet es el objeto en que abres Excel; en tu caso en lugar de excel_sheet debes poner LibroTrabajo.

            Y por supuesto, el asterisco no debes ponerlo...

            Prueba a suprimir todas esas otras variables que tienes en tu código, que no las necesitas para nada...
            José María Movilla Cuadrado
            ______________________
            Normas del foro
            www.foro.vb-mundo.com
            www.vb-mundo.com

            Comentario


            • #7
              Gracias movilla muy agradecido como siempre ya solucione y funciona perfecto. lo unico que al final de llenar los datos no me cierra el excel bien. si quiero abrir otro libro me abre y cierra el libro muy rapido, entonces voy al administrador de tareas para forzar el cierre. voy a colocar el codigo completo por si alguien necesita. y el modulo para abrir el explorador de archivos y ubicar el libro. en el modulo esta Para abrir un libro y para Guardar un libro de excel


              esto en un MODULO BAS

              Código:
              Option Explicit
               
              Private Const OFN_HIDEREADONLY = &H4
              Private Const OFN_FILEMUSTEXIST = &H1000
              Private Const OFN_CREATEPROMPT = &H2000
              Private Const OFN_OVERWRITEPROMPT = &H2
              Private Const OFN_EXPLORER = &H80000
               
              Private Type OPENFILENAME
                  lStructSize As Long
                  hwndOwner As Long
                  hInstance As Long
                  lpstrFilter As String
                  lpstrCustomFilter As String
                  nMaxCustFilter As Long
                  nFilterIndex As Long
                  lpstrFile As String
                  nMaxFile As Long
                  lpstrFileTitle As String
                  nMaxFileTitle As Long
                  lpstrInitialDir As String
                  lpstrTitle As String
                  flags As Long
                  nFileOffset As Integer
                  nFileExtension As Integer
                  lpstrDefExt As String
                  lCustData As Long
                  lpfnHook As Long
                  lpTemplateName As String
              End Type
               
              Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
              Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
               
              Dim ofn As OPENFILENAME
               
              'Muestra el cuadro de dialogo para abrir archivos:
              Public Function OpenFile(hWnd As Long, Filter As String, Title As String, InitDir As String, Optional filename As String, Optional FilterIndex As Long) As String
                  On Local Error Resume Next
               
                  Dim ofn As OPENFILENAME
                  Dim a As Long
               
                  ofn.lStructSize = Len(ofn)
                  ofn.hwndOwner = hWnd
                  ofn.hInstance = App.hInstance
               
                  If VBA.Right$(Filter, 1) <> "|" Then Filter = Filter + "|"
               
                  For a = 1 To Len(Filter)
                      If Mid$(Filter, a, 1) = "|" Then Mid(Filter, a, 1) = Chr(0)
                  Next
               
                      ofn.lpstrFilter = Filter
                      ofn.lpstrFile = Space$(254)
                      ofn.nMaxFile = 255
                      ofn.lpstrFileTitle = Space$(254)
                      ofn.nMaxFileTitle = 255
                      ofn.lpstrInitialDir = InitDir
                      If Not filename = vbNullString Then ofn.lpstrFile = filename & Space$(254 - Len(filename))
                      ofn.nFilterIndex = FilterIndex
                      ofn.lpstrTitle = Title
                      ofn.flags = OFN_HIDEREADONLY Or OFN_FILEMUSTEXIST
                      a = GetOpenFileName(ofn)
               
                      If a Then
                           OpenFile = Trim$(ofn.lpstrFile)
                           If VBA.Right$(VBA.Trim$(OpenFile), 1) = Chr(0) Then OpenFile = VBA.Left$(VBA.Trim$(ofn.lpstrFile), Len(VBA.Trim$(ofn.lpstrFile)) - 1)
               
                      Else
                           OpenFile = vbNullString
               
                      End If
               
              End Function
               
              'Muestra el cuadro de dialogo para guardar archivos:
              Public Function SaveFile(hWnd As Long, Filter As String, Title As String, InitDir As String, Optional filename As String, Optional FilterIndex As Long) As String
                  On Local Error Resume Next
               
                  Dim ofn As OPENFILENAME
                  Dim a As Long
               
                  ofn.lStructSize = Len(ofn)
                  ofn.hwndOwner = hWnd
                  ofn.hInstance = App.hInstance
               
                  If VBA.Right$(Filter, 1) <> "|" Then Filter = Filter + "|"
               
                  For a = 1 To Len(Filter)
                      If Mid(Filter, a, 1) = "|" Then Mid(Filter, a, 1) = Chr(0)
                  Next
               
                      ofn.lpstrFilter = Filter
                      ofn.lpstrFile = Space(254)
                      ofn.nMaxFile = 255
                      ofn.lpstrFileTitle = Space(254)
                      ofn.nMaxFileTitle = 255
                      ofn.lpstrInitialDir = InitDir
                      If Not filename = vbNullString Then ofn.lpstrFile = filename & Space(254 - Len(filename))
                      ofn.nFilterIndex = FilterIndex
                      ofn.lpstrTitle = Title
                      ofn.flags = OFN_HIDEREADONLY Or OFN_OVERWRITEPROMPT Or OFN_CREATEPROMPT Or OFN_EXPLORER
                      a = GetSaveFileName(ofn)
               
                      If a Then
                           SaveFile = Trim$(ofn.lpstrFile)
                           If VBA.Right$(Trim$(SaveFile), 1) = Chr(0) Then SaveFile = VBA.Left$(Trim$(ofn.lpstrFile), Len(Trim$(ofn.lpstrFile)) - 1) & GetExtension(ofn.lpstrFilter, ofn.nFilterIndex)
               
                      Else
                           SaveFile = vbNullString
               
                      End If
               
              End Function
               
              'Extrae la extension seleccionada del filtro:
              Private Function GetExtension(sfilter As String, pos As Long) As String
                  Dim Ext() As String
               
                  Ext = Split(sfilter, vbNullChar)
               
                  If pos = 1 And Ext(pos) <> "*.*" Then
                      GetExtension = "." & Replace(Ext(pos), "*.", "")
                      Exit Function
               
                  End If
               
                  If pos = 1 And Ext(pos) = "*.*" Then
                      GetExtension = vbNullString
                      Exit Function
               
                  End If
               
                  If InStr(Ext(pos + 1), "*.*") Then
                     GetExtension = vbNullString
               
                  Else
                     GetExtension = "." & Replace(Ext(pos + 1), "*.", "")
               
                  End If
               
              End Function

              y ahora el botón donde llamo la función y hace la actualización de los regiros

              Código:
              Private Sub cmdImportar_Click()
              
              Dim filename As String
              Dim xlApp As Object
              Dim xlLibro As Object
              Dim xlHoja As Object
              
              
                  Dim nRow As Integer, nCol1 As Integer, nCol2 As Integer, cStr1 As String, cStr2 As String, Cedu As Long
                  nRow = 10 'fila donde comienzan los datos
                  nCol1 = 3 'columna donde esta la cedula
                  nCol2 = 2 'columna donde esta el dato q voy a guardar
              
              
              
              'Muestra el cuadro de dialogo Abrir con un filtro de 3 tipos
              'apuntando al directorio por defecto del explorador:
              
              filename = OpenFile(Me.hWnd, "Archivo Excel|*.xlsx", "Abrir documento", "%desktop%")
              
              '||||||||recordar que para que esto funcione.. debe agregarse la referencia de microsoft excel xx Object library|||||||
              'si abrimos la busqueda, y luego la cancelamos, esto evita que salte un error....
              
              If filename = vbNullString Then
              
                    'se cierra la busqueda y vuelve al form...
              Else
                    
              
              'abrimos excel
              Set xlApp = New Excel.Application
              xlApp.Visible = False
              
              'abrir el archivo
              Set xlLibro = xlApp.Workbooks.Open(filename, True, True, , "")
              Set xlHoja = xlApp.Worksheets("FORMATO")'nombre de la hoja donde estan los datos
              
              'y aqui comienza el bucle
              
                  Do
              OtraFila:
                      cStr1 = Trim$(xlApp.Cells(nRow, nCol1))
                      Cedu = Val(cStr1)
                      If Len(cStr1) <> 0 Then
              
                         cStr2 = Trim$(xlApp.Cells(nRow, nCol2))
                         BASE.Execute "UPDATE  INAVI Set SERIAL='" & cStr2 & "' WHERE Cedula = " & Cedu & ""
              
                         nRow = nRow + 1
                         MsgBox "se cargo correctamente", vbInformation, "Aviso"
                         GoTo OtraFila
              
                      End If
                      Exit Do
                  Loop
              
               
              End If
              
              xlLibro.Close savechanges:=False
              Set xlApp = Nothing
              Set xlHoja = Nothing
              Set xlLibro = Nothing
              
              
              
              End Sub
              Última edición por jtrillo; 27-03-2017, 07:21 PM. Razón: listo ya modifique las lineas para cerrar bien la aplicacion de excel

              Comentario


              • #8
                Creo que tienes que cerrar xlApp...
                José María Movilla Cuadrado
                ______________________
                Normas del foro
                www.foro.vb-mundo.com
                www.vb-mundo.com

                Comentario


                • #9
                  Originalmente escrito por J_M_Movilla Ver mensaje
                  Creo que tienes que cerrar xlApp...
                  listo ya modifique el final. ahora si me cierra la aplicacion sin problema. saludos

                  Comentario

                  Trabajando...
                  X