none
VB no Excel RRS feed

  • Pergunta

  • Boa tarde,

    preciso fazer um scrip em VB que atualize uma tabela no SQL a partir de um botão no excel.

    Exemplo: Tenho uma planilha de dados no excel, quero enviar esses dados para a tabela no SQL através de um botão com a ação de atualizar.

    É possível?

    Obrigada.

    sexta-feira, 19 de agosto de 2011 17:13

Respostas

  • Vamos lá Suenne,

    Pederá começar lendo isso

    http://support.microsoft.com/kb/321686/pt-br

    Não será atraves de um notão e sim de um icone fora ok

    voce ira preencher o seu xls na linha 1A coloque numero 1 na 1B numero2

    A partir da segunda linha voce ira colocar os seus dado ok

    Segue script VBS para imputar Xls em SQL

    Este eu uso para cadastrar usuários nos sistemas internos.

     

    ' ------------------------------------------------------'
    Option Explicit
    Dim objRootLDAP, objContainer, objUser, objShell, WshShell, oShell, objConnection, objRecordSet, args
    Dim objExcel, objSpread, intRow
    Dim strUser, strOU, strSheet 
    Dim Agora
    Dim strCN, strSam, strFirst, strLast, strPWD, strFull, strSource, strTel, strCel, strFax, strWeb, strDesc, strMail, strGrupo, strPapel, strChat, data
    
    ' -------------------------------------------------------------'
    
    ' -------------------------------------------------------------'
    
    Set oShell = CreateObject("WScript.Shell") 
    
    strSheet = oShell.CurrentDirectory & "\UserSpread1.xls"
    
    ' Open the Excel spreadsheet
    Set objExcel = CreateObject("Excel.Application")
    Set objSpread = objExcel.Workbooks.Open(strSheet)
    intRow = 4 'Row 1 often contains headings
    
    
    ' Here is the 'DO...Loop' that cycles through the cells
    ' Note intRow, x must correspond to the column in strSheet
    Do Until objExcel.Cells(intRow,1).Value = "." 
     strSam = Trim(objExcel.Cells(intRow, 1).Value)
     strCN = Trim(objExcel.Cells(intRow, 2).Value)
     strFirst = Trim(objExcel.Cells(intRow, 3).Value)
     strLast = Trim(objExcel.Cells(intRow, 4).Value)
     strPWD = Trim(objExcel.Cells(intRow, 5).Value)
     strFull = Trim(objExcel.Cells(intRow, 6).value)
     strSource = Trim(objExcel.Cells(intRow, 7).value)
     strTel = Trim(objExcel.Cells(intRow, 8).value)
     strCel = Trim(objExcel.Cells(intRow, 9).value)
     strFax = Trim(objExcel.Cells(intRow, 10).value)
     strWeb = Trim(objExcel.Cells(intRow, 11).value)
     strDesc = Trim(objExcel.Cells(intRow, 12).value)
     strMail = Trim(objExcel.Cells(intRow, 13).value)
     strGrupo = Trim(objExcel.Cells(intRow,14).value)
     strPapel = Trim(objExcel.Cells(intRow,15).value)
    
    
    ' ****** Aqui ele conecta no data base 
    ' ****** Connect to a SQL Server Database
    
    
    Const adOpenStatic = 3
    Const adLockOptimistic = 3
    
    Set objConnection = CreateObject("ADODB.Connection")
    Set objRecordSet = CreateObject("ADODB.Recordset")
    
    objConnection.Open _
     "Provider=SQLOLEDB;Data Source=atisv002;" & _
      "Trusted_Connection=Yes;Initial Catalog=ECM_Homologacao;" & _
        "User ID=leonardi\edson.fagundes;Password=#edsjr24#;"
    
    objRecordSet.Open "SELECT * FROM COLABORADOR", _
      objConnection, adOpenStatic, adLockOptimistic
    
    objRecordSet.AddNew
    objRecordSet("CD_MATRICULA") = strSam
    objRecordSet("COD_EMPRESA") = "1" 
    objRecordSet("ID_ATIVO") = "1" 
    objRecordSet("ID_ATIVO") = "1" 
    objRecordSet("NM_COLABORADOR") = StrCN   
    objRecordSet("IND_IDIOM_PADR") = "pt"   
    objRecordSet("COD_DIALETO") = "pt"
    objRecordSet("DS_AREA_ESPECIALIZACAO") = strDesc
    objRecordSet("COD_GRP_TRAB") = strGrupo
    objRecordSet("LOGIN") = strSam
    objRecordSet("E_MAIL") = strMail   
    objRecordSet("SENHA") = "949fd25bc81af6e53440a530c3143d62"
    objRecordSet("NR_RAMAL") = strTel 
    objRecordSet("LOG_EMAIL_HTML") = "1"
    objRecordSet("LOG_USUAR_ADM") = "0"
    objRecordSet("NR_AREA_1") = "0"
    objRecordSet("NR_AREA_2") = "0"
    objRecordSet("NR_AREA_3") = "0"
    objRecordSet("NR_AREA_4") = "0"
    objRecordSet("NR_AREA_5") = "0"
    objRecordSet("DS_PROJETOS_ATUAIS") = " "
    objRecordSet("LOG_USUAR_GED") = "1"
    objRecordSet("IND_CONFIGUR_MENU") = "0"
    objRecordSet("LOG_USUAR_PUBLIC_NEWS") = "0"
    objRecordSet("LOG_USUAR_NOMINAL") = "0"
    objRecordSet("COD_VOL_FISIC") = "Default"
    objRecordSet.Update
    objRecordSet.Close
    
    
    '***Aqui termina acesso ao SQL
    
    
     MsgBox("Foi cadastrado")
    
    'On Error GoTo TrataErro
    On Error Resume Next
    
    
    intRow = intRow + 1
    Loop
    objExcel.Quit
    
    
    WScript.Quit

    me encaminhe o modelo da sua planilha para que eu possa lhe ajudar melhor. emfagundesjr@gmail.com

     

     

    Abraços


    Edson Matias Fagundes Junior - (Nioks)
    MCP, MCTS: 2008, MCTS:MBS
    Se a resposta for valida por favor vote como útil.
    sexta-feira, 19 de agosto de 2011 17:40

Todas as Respostas

  • Vamos lá Suenne,

    Pederá começar lendo isso

    http://support.microsoft.com/kb/321686/pt-br

    Não será atraves de um notão e sim de um icone fora ok

    voce ira preencher o seu xls na linha 1A coloque numero 1 na 1B numero2

    A partir da segunda linha voce ira colocar os seus dado ok

    Segue script VBS para imputar Xls em SQL

    Este eu uso para cadastrar usuários nos sistemas internos.

     

    ' ------------------------------------------------------'
    Option Explicit
    Dim objRootLDAP, objContainer, objUser, objShell, WshShell, oShell, objConnection, objRecordSet, args
    Dim objExcel, objSpread, intRow
    Dim strUser, strOU, strSheet 
    Dim Agora
    Dim strCN, strSam, strFirst, strLast, strPWD, strFull, strSource, strTel, strCel, strFax, strWeb, strDesc, strMail, strGrupo, strPapel, strChat, data
    
    ' -------------------------------------------------------------'
    
    ' -------------------------------------------------------------'
    
    Set oShell = CreateObject("WScript.Shell") 
    
    strSheet = oShell.CurrentDirectory & "\UserSpread1.xls"
    
    ' Open the Excel spreadsheet
    Set objExcel = CreateObject("Excel.Application")
    Set objSpread = objExcel.Workbooks.Open(strSheet)
    intRow = 4 'Row 1 often contains headings
    
    
    ' Here is the 'DO...Loop' that cycles through the cells
    ' Note intRow, x must correspond to the column in strSheet
    Do Until objExcel.Cells(intRow,1).Value = "." 
     strSam = Trim(objExcel.Cells(intRow, 1).Value)
     strCN = Trim(objExcel.Cells(intRow, 2).Value)
     strFirst = Trim(objExcel.Cells(intRow, 3).Value)
     strLast = Trim(objExcel.Cells(intRow, 4).Value)
     strPWD = Trim(objExcel.Cells(intRow, 5).Value)
     strFull = Trim(objExcel.Cells(intRow, 6).value)
     strSource = Trim(objExcel.Cells(intRow, 7).value)
     strTel = Trim(objExcel.Cells(intRow, 8).value)
     strCel = Trim(objExcel.Cells(intRow, 9).value)
     strFax = Trim(objExcel.Cells(intRow, 10).value)
     strWeb = Trim(objExcel.Cells(intRow, 11).value)
     strDesc = Trim(objExcel.Cells(intRow, 12).value)
     strMail = Trim(objExcel.Cells(intRow, 13).value)
     strGrupo = Trim(objExcel.Cells(intRow,14).value)
     strPapel = Trim(objExcel.Cells(intRow,15).value)
    
    
    ' ****** Aqui ele conecta no data base 
    ' ****** Connect to a SQL Server Database
    
    
    Const adOpenStatic = 3
    Const adLockOptimistic = 3
    
    Set objConnection = CreateObject("ADODB.Connection")
    Set objRecordSet = CreateObject("ADODB.Recordset")
    
    objConnection.Open _
     "Provider=SQLOLEDB;Data Source=atisv002;" & _
      "Trusted_Connection=Yes;Initial Catalog=ECM_Homologacao;" & _
        "User ID=leonardi\edson.fagundes;Password=#edsjr24#;"
    
    objRecordSet.Open "SELECT * FROM COLABORADOR", _
      objConnection, adOpenStatic, adLockOptimistic
    
    objRecordSet.AddNew
    objRecordSet("CD_MATRICULA") = strSam
    objRecordSet("COD_EMPRESA") = "1" 
    objRecordSet("ID_ATIVO") = "1" 
    objRecordSet("ID_ATIVO") = "1" 
    objRecordSet("NM_COLABORADOR") = StrCN   
    objRecordSet("IND_IDIOM_PADR") = "pt"   
    objRecordSet("COD_DIALETO") = "pt"
    objRecordSet("DS_AREA_ESPECIALIZACAO") = strDesc
    objRecordSet("COD_GRP_TRAB") = strGrupo
    objRecordSet("LOGIN") = strSam
    objRecordSet("E_MAIL") = strMail   
    objRecordSet("SENHA") = "949fd25bc81af6e53440a530c3143d62"
    objRecordSet("NR_RAMAL") = strTel 
    objRecordSet("LOG_EMAIL_HTML") = "1"
    objRecordSet("LOG_USUAR_ADM") = "0"
    objRecordSet("NR_AREA_1") = "0"
    objRecordSet("NR_AREA_2") = "0"
    objRecordSet("NR_AREA_3") = "0"
    objRecordSet("NR_AREA_4") = "0"
    objRecordSet("NR_AREA_5") = "0"
    objRecordSet("DS_PROJETOS_ATUAIS") = " "
    objRecordSet("LOG_USUAR_GED") = "1"
    objRecordSet("IND_CONFIGUR_MENU") = "0"
    objRecordSet("LOG_USUAR_PUBLIC_NEWS") = "0"
    objRecordSet("LOG_USUAR_NOMINAL") = "0"
    objRecordSet("COD_VOL_FISIC") = "Default"
    objRecordSet.Update
    objRecordSet.Close
    
    
    '***Aqui termina acesso ao SQL
    
    
     MsgBox("Foi cadastrado")
    
    'On Error GoTo TrataErro
    On Error Resume Next
    
    
    intRow = intRow + 1
    Loop
    objExcel.Quit
    
    
    WScript.Quit

    me encaminhe o modelo da sua planilha para que eu possa lhe ajudar melhor. emfagundesjr@gmail.com

     

     

    Abraços


    Edson Matias Fagundes Junior - (Nioks)
    MCP, MCTS: 2008, MCTS:MBS
    Se a resposta for valida por favor vote como útil.
    sexta-feira, 19 de agosto de 2011 17:40
  • Ok Edson, vou te enviar, você tem MSN?
    sexta-feira, 19 de agosto de 2011 17:53
  • Edson, bom dia!

    te enviei a planilha, conseguiu verificar?

    Obrigada.

    segunda-feira, 22 de agosto de 2011 11:56
  • Irei verificar hj nos falamos mais tarde, pode ser???

     

    Abraços

     


    Edson Matias Fagundes Junior - (Nioks)
    MCP, MCTS: 2008, MCTS:MBS
    Se a resposta for valida por favor vote como útil.
    segunda-feira, 22 de agosto de 2011 12:00
  • Ok Edson, aguardo seu contato.
    segunda-feira, 22 de agosto de 2011 13:26
  • Ola Suenne,

    Conseguiu efetuar os teste funcionou.

    Abraços

     


    Edson Matias Fagundes Junior - (Nioks)
    MCP, MCTS: 2008, MCTS:MBS
    Se a resposta for valida por favor vote como útil.
    terça-feira, 30 de agosto de 2011 18:49