Vagner Nicolodi

Ricardo: To vendo a macro pra ti tá ... logo logo tá pronto e ai eu envio ela pra ti ! Abraço

Amigo, Meu e-mail é vagnernico@gmail.com No aguardo, Vagner Nicolodi

Amigo: Favor informar quais células na planilha deverão ser preenchidas ... Ou mande ele para poder ver essa planilha e entender a mesma! Atenciosamente, Vagner Nicolodi

Use o seguinte código: Sub Zip_File_Or_Files() Dim strDate As String, DefPath As String, sFName As String Dim oApp As Object, iCtr As Long, I As Integer Dim FName, vArr, FileNameZip DefPath = Application.DefaultFilePath If Right(DefPath, 1) <> "\" Then DefPath = DefPath & "\" End If strDate = Format(Now, " dd-mmm-yy h-mm-ss") FileNameZip = DefPath & "MyFilesZip " & strDate & ".zip" 'Selecionar o arquivo(s), use o Ctrl para selecionar mais de 1 arquivo FName = Application.GetOpenFilename(filefilter:="Excel Files (*.xls), *.xls", _ MultiSelect:=True, Title:="Selecione os arquivos a serem zipados") If IsArray(FName) = False Then 'Não faz nada Else 'Criar um arquivo Zip do Windows vazio NewZip (FileNameZip) Set oApp = CreateObject("Shell.Application") I = 0 For iCtr = LBound(FName) To UBound(FName) vArr = Split97(FName(iCtr), "\") sFName = vArr(UBound(vArr)) If bIsBookOpen(sFName) Then MsgBox "Você não pode zipar um documento aberto!" & vbLf & _ "Favor fechar o arquivo e tente novamente: " & FName(iCtr) Else 'Copiar o documento para o diretório zipado I = I + 1 oApp.NameSpace(FileNameZip).CopyHere (FName(iCtr)) End If Next iCtr 'Manter o código aguardando até acabar de zipar On Error Resume Next Do Until oApp.NameSpace(FileNameZip).items.Count = I Application.Wait (Now + TimeValue("0:00:01")) Loop MsgBox "Você encontrará o arquivo zipado aqui: " & FileNameZip On Error GoTo 0 Set oApp = Nothing End If End Sub Atenciosamente, Vagner Nicolodi

Você poderia usar algo mais ou menos assim: Private Sub CommandButton1_Click() Columns(1).Find(TextBoxCodProduto).activate On Error GoTo Error1 TextBoxProduto = Cells(ActiveCell.Row, 2).value 'Somente se o valor produto estiver na coluna 2 TextBoxIndustria = Cells(ActiveCell.Row, 3).value 'Somente se o valor industria estiver na coluna 3 TextBoxPreçoUnitario = Cells(ActiveCell.Row, 4).value 'Somente se o valor unitario estiver na coluna 4 Exit Sub Error1: MsgBox("O código referido não foi localizado em nosso cadastro, providencie o cadastramento e reexecute a aplicação") End Sub Altera a numeração das colunas conforme o teu Banco de Dados. Atenciosamente, Vagner Nicolodi

Caro Fabiano: Eu tenho alguns exemplos de códigos para enviar e-mails diretamente pelo SMTP ... você teria como me informar se os e-mails a serem enviados contém anexos, ou seria apenas texto .. qual tipo de e-mail seria ?!

Galera ... O problema real seria para conseguir as quantidades .... posso identificar quando a variável recebe uma letra pelo metódo if usando os characters ASCII ... porém se tiverem como me dar uma idéia de código que retire os valores de dentro da célula ... para retirar valores posso utilizar o ActiveCell.Characters(Star:=X, Lenght:=Y).Text ... poré como identificar após a barra ???