Macêdo

jilney@hotmail.com jilneyom@bnb.gov.br

Estou precisando fazer uma mala direta, tenho um modelo de carta onde gostaría que ao selecionar o registro no meu form a carta fosse preenchida com os dados do cliente nos locais corretos dentro do texto (nome, endereço, ...) Encontrei algo assim no site Macoratti, usando o OLE, mas acho que não consegui adaptar ao modo como estou ligando meu BD, com adodc.

Cara estou tentando imaginar como realmente está acontecendo mas tá dificil, se tiver como explicar melhor, já sei qual o erro, tudo bem, mas pra resolver seria preciso saber mais sobre seu aplicativo, mas vai uma dica: Coloque no form para ficar visivel e disponivel para digitação textbox's não vinculadas ao DataControl e ponha condições para que essas text's não vinculadas preencham as textbox's vinculadas, as quais você irá deixar visible=false, deu pra entender? este campo que ta gerando problema você pode fazer assim; um textnaovinculado que quando preenchido passe o valor para outras testes que irão gravar nas tabelas: private sub textnaovinculado_Lostfocus() textvinculado.text=textnaovinculado.text end sub será que serve?, se puder postar mais sobre o funcionamento, ou os próprios nomes dos controles e tal...vamos conseguir chegar lá, não é dificil não.

Tem como fazer para que fique configurado com os Components, referencias, barras de menus...etc que eu mais uso, porque toda vez que entro no VB ele aparece só com o Basico e tenho que inserir tudo novamente.

Cara, é o seguinte, eu trabalho com o ADODC, mas como tem uma certa aparencia no modo de trabalho com o Datacontrol vou tentar te passar algo, mas ta um pouco confusa sua explicação Pelo que entendi você tem uma tabela onde você cadastra os clientes e outra os atendimentos certo. Se esta mudando o nome na tabela clientes é porque o campo da tabela atendimento esta vinculado à tabela de clientes. você deveria usar dois contoles datacontrol neste mesmo form o primeiro vinculado com a tebela clientes para fazer a busca na tabela clientes, com uma SQL no campo Recordsouce, ou outra foma que se encaixe melhor em sua busca. o segundo para vincular os campo do atendimento com a tabela de atendimento, gravando os dados nesta tabela sem interferir na tabela clientes.

Kuroi!, eu usei outro instalador, já criei também com o package mas não consigo instalar com ele, acho complicado, ele cria uma pasta "PACKAGE", com outra pasta dentro "SUPORTE" + o arquivo .EXE e outras "4 pastas" que aparecem com icones de gavetas e fico perdido quando vejo tantos arquivos, não sei como proceder para a instalação, cê pode dar uma dica? Usei o Package e consegui, valeu! por falar em agradecer, valeu a dica que você pôs sobre linhas multiplas de comentário, essa foi de Mestre!

Esta aparecendo o seguinte erro: Component 'MSADODC.OCX' or one of its dependencies not correct registred: a file missing invalid. Não sei se tem haver mas, é a segunda vez que tento criar um programa contendo o controle TabStrip e aparece este erro.

Para isto veja qual o indice do campo que você quer que seja retirado, em seguida ponha uma condição no evento GotFocus da combo, assim: Private Sub Combo1_GotFocus() If Option1.Value Then Combo1.RemoveItem 1 End If End Sub veja a condição: se o option1 estiver marcado, o item de indice 1 irá desaparecer.

Função para Validar CPF (colocar a função num modulo e no textbox do form chamar o nome da função no evento LostFocus,) Ponha o seguinte código num módulo: Function FU_ValidaCPF(CPF As String) As Integer ' Dim soma As Integer Dim Resto As Integer Dim i As Integer CPF = Replace(CPF, ".", "") CPF = Replace(CPF, "-", "") CPF = Replace(CPF, "/", "") 'Valida argumento If Len(CPF) <> 11 Then FU_ValidaCPF = False Exit Function End If soma = 0 For i = 1 To 9 soma = soma + Val(Mid$(CPF, i, 1)) * (11 - i) Next i Resto = 11 - (soma - (Int(soma / 11) * 11)) If Resto = 10 Or Resto = 11 Then Resto = 0 If Resto <> Val(Mid$(CPF, 10, 1)) Then FU_ValidaCPF = False Exit Function End If soma = 0 For i = 1 To 10 soma = soma + Val(Mid$(CPF, i, 1)) * (12 - i) Next i Resto = 11 - (soma - (Int(soma / 11) * 11)) If Resto = 10 Or Resto = 11 Then Resto = 0 If Resto <> Val(Mid$(CPF, 11, 1)) Then FU_ValidaCPF = False Exit Function End If FU_ValidaCPF = True End Function agora vá até a textbox onde é digitado o CPF e ponha no evento LostFocus: 'no exemplo a textbox é a text5 Private Sub Text5_LostFocus() If FU_ValidaCPF(Text5.Text) = 0 Then MsgBox ("CPF Inválido") Text5.SetFocus End If (quando o resultado = 0 CPF invalido quando resultado = -1 CPF correto), por isso que colocamos a instrução se=0 e caso sendo realmente incorreto aparecerá a mensagem informando e quando clicar na mensagem o foco voltará ao campo para que o usuário digite novamente o CPF.

Eu utilizei o package para gerar o arquivo Setup para meu aplicativo, porém ele só funciona nos computadores de minha empresa, que estão em rede, os usuários acessam uma pasta publica e instalam o aplicativo através do Setup e o Aplicativo roda beleza em qualquer máquina, porém quando tento instalá-lo em outro computador fora da empresa ele não roda, dá mensagem de erro com o banco de dados, mas o Setup não incorpora o banco de dados ao aplicativo? o que pode estar acontecendo?

Tentei mas, aparece uma caixa com o nome do controle adodc1 informando: "erro de sintaxe da clausula from" e depois aparece a caixa de código com a linha "adodc1.refresh" destacada em amarelo, mas se eu utilizar um outro controle adodc2 com esta SQL na recordsource e eu configurar as propriedades datasource e datafield da text12 para o adodc2 retorna o valor correto, mas eu não queria ter que usar outro controle, afinal, depois podem aparecer outras necessidades parecidas e ai eu vou ter que inserir inúmeros adodc para me retornarem outras consultas, você pode verificar isso? desde já agradeço a atenção.

Bom dia pessoal! Galera, tenho uma conexão adodc1 e estou tentando retornar na text12 o somatório do campo saldo de minha tabela dados. fiz o seguinte: Private Sub Command2_Click() Text12.Text = Adodc1.RecordSource = "select sum(saldo) from * dados where saldo <> 0" isto está retornando para a text12 false então? o que fazer para que me retorne a soma deste campo?

Adicione um módulo ao Projeto e ponha nele a seguinte função: Public Function VALOREXTENSO(NUMERO As Currency) As String If IsNull(NUMERO) Or NUMERO = 0 Then VALOREXTENSO = "Numero Faltando ou igual a zero" Exit Function End If If NUMERO > 99000# Then MsgBox "O Valor máximo para conversão por extenso é R$ 99.000,00 !", vbInformation, "Número muito alto" VALOREXTENSO = "Número excede a faixa..." Exit Function End If Dim U(1 To 9) As String 'Unidades (1 - 9) U(1) = "um" U(2) = "dois" U(3) = "três" U(4) = "quatro" U(5) = "cinco" U(6) = "seis" U(7) = "sete" U(8) = "oito" U(9) = "nove" Dim DD(1 To 9) As String 'Dez e ... (11 - 19) DD(1) = "onze" DD(2) = "doze" DD(3) = "treze" DD(4) = "quatorze" DD(5) = "quinze" DD(6) = "dezesseis" DD(7) = "dezessete" DD(8) = "dezoito" DD(9) = "dezenove" Dim D(1 To 10) As String 'Dezenas (10,20,30, ..., 100) D(1) = "dez" D(2) = "vinte" D(3) = "trinta" D(4) = "quarenta" D(5) = "cinqüenta" D(6) = "sessenta" D(7) = "setenta" D(8) = "oitenta" D(9) = "noventa" D(10) = "cem" Dim C(1 To 10) As String 'Centenas (100,200, ..., 1.000) C(1) = "cento" C(2) = "duzentos" C(3) = "trezentos" C(4) = "quatrocentos" C(5) = "quinhentos" C(6) = "seiscentos" C(7) = "setecentos" C(8) = "oitocentos" C(9) = "novecentos" C(10) = "mil" Dim TEXTO As String 'Variável utilizada para montar e armazenar o valor por extenso TEXTO = "" Dim StrNUMERO As String 'Vairável utilizada para armazenar o valor em forma de string StrNUMERO = Str(NUMERO) Dim TamNUMERO As Integer 'Tamanho do Número Dim PI, PF As Integer 'Variáveis utilizadas em subrotinas de milhares If InStr(1, StrNUMERO, ".", vbTextCompare) > 0 Then 'Se existe casas decimais Dim DEC As String DEC = Right(StrNUMERO, 2) 'Extraindo os dois último valores If InStr(1, DEC, ".", vbTextCompare) > 0 Then 'Se apenas 1 casa decimal acrescente 0 DEC = Right(DEC, 1) & "0" 'Acrescentando 0 StrNUMERO = Str(Int(Val(StrNUMERO))) & "." & Trim(DEC) 'Atualizando as casas decimais End If Else StrNUMERO = StrNUMERO & ".00" 'Acrescentando 00 End If If Int(Val(StrNUMERO)) = 0 Then StrNUMERO = "0" & Trim(StrNUMERO) End If TamNUMERO = Len(Trim(StrNUMERO)) 'Centavos Dim X1, X2, X3 As Integer X1 = Val(Right(StrNUMERO, 2)) X2 = Val(Left(Trim(Str(X1)), 1)) ' 1 Casa decimal X3 = Val(Right(Trim(Str(X1)), 1)) '2º Casa decimal If X1 > 0 Then 'Existe centavos If X1 = 1 Then TEXTO = "um centavo" Else If X1 < 11 Then 'Entre 2 e 10 If X1 = 10 Then 'Dez TEXTO = "dez centavos" Else TEXTO = U(X3) & " centavos" End If ElseIf X1 > 10 And X1 < 20 Then 'Entre 11 e 19 TEXTO = DD(X3) & " centavos" ElseIf X1 = 20 Or X1 = 30 Or X1 = 40 Or X1 = 50 Or X1 = 60 Or X1 = 70 Or X1 = 80 Or X1 = 90 Then TEXTO = D(X2) & " centavos" Else 'Valores entre 21 e 99 exceto os redondos (20, 30, etc...) TEXTO = D(X2) & " e " & U(X3) & " centavos" End If End If Else 'Não existe centavos TEXTO = "" End If 'REAIS 'Unidades e Dezenas Dim DEZ, DEZ1, DEZ2 As Integer Dim strDEZ As String DEZ = Int(Val(StrNUMERO)) strDEZ = Trim(Str(DEZ)) DEZ = Val(Right(strDEZ, 2)) strDEZ = IIf(Len(strDEZ) = 1, "0" & strDEZ, strDEZ) DEZ1 = Val(Mid(Trim(strDEZ), (Len(Trim(strDEZ)) - 1), 1)) DEZ2 = Val(Right(strDEZ, 1)) If DEZ = 10 Or DEZ = 20 Or DEZ = 30 Or DEZ = 40 Or DEZ = 50 Or DEZ = 60 Or DEZ = 70 Or DEZ = 80 Or DEZ = 90 Then If Len(Trim(TEXTO)) > 0 Then TEXTO = D(DEZ1) & " reais e " & TEXTO Else TEXTO = D(DEZ1) & " reais" End If ElseIf DEZ > 0 And DEZ < 10 Then 'Entre 1 e 9 reais If DEZ = 1 Then TEXTO = IIf(Len(Trim(TEXTO)) = 0, "um real", U(DEZ2) & " real e " & TEXTO) Else TEXTO = IIf(Len(Trim(TEXTO)) = 0, U(DEZ2) & " reais", U(DEZ2) & " reais e " & TEXTO) End If ElseIf DEZ > 10 And DEZ < 20 Then 'Entre 11 e 19 TEXTO = IIf(Len(Trim(TEXTO)) = 0, DD(DEZ2) & " reais", DD(DEZ2) & " reais e " & TEXTO) Else 'Valores entre 21 e 99 exceto os inteiros (20,30, etc...) If DEZ > 0 Then TEXTO = IIf(Len(Trim(TEXTO)) = 0, D(DEZ1) & " e " & U(DEZ2) & " reais", D(DEZ1) & " e " & U(DEZ2) & " reais e " & TEXTO) End If 'Centenas Dim CEM, CEM1, CEM2 As Integer Dim StrCEM As String CEM = Int(Val(StrNUMERO)) If CEM > 99 Then 'Se existir centenas CEM = (CEM - DEZ) / 100 If CEM > 9 Then 'Existe milhar(es) CEM = Val(Right(Str(CEM), 1)) End If If CEM = 1 Then If DEZ > 0 Then TEXTO = C(CEM) & " e " & TEXTO Else TEXTO = IIf(Len(Trim(TEXTO)) = 0, "cem reais", C(CEM) & " reais e " & TEXTO) End If ElseIf CEM > 1 Then If DEZ > 0 Then TEXTO = C(CEM) & " e " & TEXTO Else TEXTO = IIf(Len(Trim(TEXTO)) = 0, C(CEM) & " reais", C(CEM) & " reais e " & TEXTO) End If End If End If 'Unidades e Dezenas de Milhar Dim MIL As Currency MIL = Int(Val(StrNUMERO)) If MIL >= 1000 Then 'Existe Milhar If CEM > 0 Then MIL = MIL - CEM If DEZ > 0 Then MIL = MIL - DEZ MIL = Int(MIL / 1000) Dim MIL1, MIL2 As Integer Dim strMIL As String strMIL = Trim(Str(MIL)) MIL1 = Val(Left(MIL, 1)) MIL2 = Val(Right(MIL, 1)) If MIL = 1 Then If Len(Trim(TEXTO)) > 0 Then 'Existe valores inferiores a mil If InStr(1, TEXTO, "rea", vbTextCompare) > 0 Then 'já existe reais PI = InStr(1, TEXTO, "real", vbTextCompare) PF = InStr(1, TEXTO, "real", vbTextCompare) + 3 If PI > 0 Then If InStr(1, TEXTO, "centavo", vbTextCompare) > 0 Then 'tem centavos TEXTO = "hum mil e " & Left(TEXTO, PI - 1) & "reais" & Right(TEXTO, Len(TEXTO) - PF) Else TEXTO = "hum mil e " & Left(TEXTO, (PI - 1)) & "reais" End If Else TEXTO = "hum mil e " & TEXTO End If Else 'só existe centavos TEXTO = "hum mil reais e " & TEXTO End If Else TEXTO = "hum mil reais" End If ElseIf MIL > 1 And MIL < 10 Then 'Casa de milhar entre 2000 e 9000 If Len(Trim(TEXTO)) > 0 Then 'Existe valores inferiores a mil If InStr(1, TEXTO, "rea", vbTextCompare) > 0 Then 'já existe reais PI = InStr(1, TEXTO, "real", vbTextCompare) PF = InStr(1, TEXTO, "real", vbTextCompare) + 3 If PI > 0 Then If InStr(1, TEXTO, "centavo", vbTextCompare) > 0 Then 'tem centavos TEXTO = U(MIL2) & " mil e " & Left(TEXTO, PI - 1) & "reais" & Right(TEXTO, Len(TEXTO) - PF) Else TEXTO = U(MIL2) & " mil e " & Left(TEXTO, (PI - 1)) & "reais" End If Else TEXTO = U(MIL2) & " mil e " & TEXTO End If Else 'só existe centavos TEXTO = U(MIL2) & " mil reais e " & TEXTO End If Else TEXTO = U(MIL2) & " mil reais" End If ElseIf MIL = 20 Or MIL = 30 Or MIL = 40 Or MIL = 50 Or MIL = 60 Or MIL = 70 Or MIL = 80 Or MIL = 90 Then 'Valores redondos 20mil, 30mil, etc.. If Len(Trim(TEXTO)) > 0 Then 'Existe valores inferiores a mil If InStr(1, TEXTO, "rea", vbTextCompare) > 0 Then 'já existe reais PI = InStr(1, TEXTO, "real", vbTextCompare) PF = InStr(1, TEXTO, "real", vbTextCompare) + 3 If PI > 0 Then If InStr(1, TEXTO, "centavo", vbTextCompare) > 0 Then 'tem centavos TEXTO = D(MIL1) & " mil e " & Left(TEXTO, PI - 1) & "reais" & Right(TEXTO, Len(TEXTO) - PF) Else TEXTO = D(MIL1) & " mil e " & Left(TEXTO, (PI - 1)) & "reais" End If Else TEXTO = D(MIL1) & " mil e " & TEXTO End If Else 'só existe centavos TEXTO = D(MIL1) & " mil reais e " & TEXTO End If Else TEXTO = D(MIL1) & " mil reais" End If ElseIf MIL > 10 And MIL < 20 Then 'Valores entre 11 e 19 mil If Len(Trim(TEXTO)) > 0 Then 'Existe valores inferiores a mil If InStr(1, TEXTO, "rea", vbTextCompare) > 0 Then 'já existe reais PI = InStr(1, TEXTO, "real", vbTextCompare) PF = InStr(1, TEXTO, "real", vbTextCompare) + 3 If PI > 0 Then If InStr(1, TEXTO, "centavo", vbTextCompare) > 0 Then 'tem centavos TEXTO = DD(MIL2) & " mil e " & Left(TEXTO, PI - 1) & "reais" & Right(TEXTO, Len(TEXTO) - PF) Else TEXTO = DD(MIL2) & " mil e " & Left(TEXTO, (PI - 1)) & "reais" End If Else TEXTO = DD(MIL2) & " mil e " & TEXTO End If Else 'só existe centavos TEXTO = DD(MIL2) & " mil reais e " & TEXTO End If Else TEXTO = DD(MIL2) & " mil reais" End If Else If Len(Trim(TEXTO)) > 0 Then 'Existe valores inferiores a mil If InStr(1, TEXTO, "rea", vbTextCompare) > 0 Then 'já existe reais PI = InStr(1, TEXTO, "real", vbTextCompare) PF = InStr(1, TEXTO, "real", vbTextCompare) + 3 If PI > 0 Then If InStr(1, TEXTO, "centavo", vbTextCompare) > 0 Then 'tem centavos TEXTO = D(MIL1) & " e " & U(MIL2) & " mil e " & Left(TEXTO, PI - 1) & "reais" & Right(TEXTO, Len(TEXTO) - PF) Else TEXTO = D(MIL1) & " e " & U(MIL2) & " mil e " & Left(TEXTO, (PI - 1)) & "reais" End If Else TEXTO = D(MIL1) & " e " & U(MIL2) & " mil e " & TEXTO End If Else 'só existe centavos TEXTO = D(MIL1) & " e " & U(MIL2) & " mil reais e " & TEXTO End If Else TEXTO = D(MIL1) & " e " & U(MIL2) & " mil reais" End If End If End If VALOREXTENSO = TEXTO End Function Agora insira 2 Textbox's No text1 ponha no envento lostFocus: text2.text=VALOREXTENSO(text1.text) Pronto!

Ponha o seguinte código num botão: Dim intTamanho As Integer intTamanho = datagrid1.Width datagrid1.Width = Printer.Width Printer.PaintPicture datagrid1.CaptureImage, 0, 0 Printer.EndDoc datagrid1.Width = intTamanho Pronto! é só clicar e imprimir seu DataGrid.

Para acessar um arquivo qualquer através do VB realize a seguinte rotina: 1 - tenha em mente o arquivo que quer abrir, por exemplo, uma planilha do excel. 2 - No VB dê dois clicks no Objeto OLE, irá aparecer a caixa: Inserir Objeto 3 - Click no botão de opção: Criar do arquivo 4 - Click no botão procurar e localize a pasta onde se encontra a Planilha, clicando nela. 5 - Marque a caixa: Exibir como ícone 6 - Ponha na propriedade do objeto OLE1 Visible=false 7 - Insira um botão de comando e ponha no evento Click o código: Dim NumArquivo As Integer NumArquivo = FreeFile Open "arquivo.OLE" For Binary As #NumArquivo OLE1.FileNumber = NumArquivo OLE1.Action = 7 Close #NumArquivo 8 - agora rode e faça o teste, ao clicar no botão sua planilha está aberta.

Colocar no evento Activate do form: Dim iTempo As Single, bDiminui As Boolean Dim iNum As Integer, iLarg As Integer Dim iLargT As Integer, Texto As String iTempo = Timer Do While Not bFechado If Timer > iTempo + 0.01 Then iTempo = Timer Select Case bDiminui Case False iNum = iNum + 1 Texto = String(iNum, " ") & _ "[color=#FF0000]Caprion do form[/color]" iLargT = TextWidth(Texto) iLarg = ScaleWidth - 1110 If iLargT >= iLarg Then iNum = iNum - 2 bDiminui = True Texto = String(iNum, " ") & _ "Linda" End If Case Else iNum = iNum - 1 If iNum < 1 Then iNum = 1 Texto = "Mens" bDiminui = False Else Texto = String(iNum, " ") & _ "[color=#FF0000]Outro Caption[/color] " End If End Select Caption = Texto End If DoEvents Loop End Sub Por no evento unload do form: bFechado = True

Lançar o Código abaixo em General Declarations do form: Option Explicit Private Const CB_FINDSTRING As Long = &H14C Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ lParam As Any) As Long Public Function Combo_AutoCompletar(xCombo As ComboBox, ByVal xKeyAscii As Long, Optional ByVal xUpperCase As Boolean = True) As Long Dim lngFind As Long, intPos As Long, intLength As Long, tStr As String With xCombo If xKeyAscii = 8 Then If .SelStart = 0 Then Exit Function .SelStart = .SelStart - 1 .SelLength = Len(.Text) .SelText = vbNullString Else intPos = .SelStart tStr = .Text .SelText = (Chr$(xKeyAscii)) ' .SelText = IIf(xUpperCase, _ ' UCase$(Chr$(xKeyAscii)), _ ' LCase$(Chr$(xKeyAscii))) End If lngFind = SendMessage(.hwnd, CB_FINDSTRING, 0, ByVal .Text) If lngFind = -1 Then .Text = tStr .SelStart = intPos .SelLength = (Len(.Text) - intPos) Combo_AutoCompletar = xKeyAscii Else intPos = .SelStart intLength = Len(.List(lngFind)) - Len(.Text) .SelText = .SelText & Right$(.List(lngFind), intLength) .SelStart = intPos .SelLength = intLength End If End With End Function Lançar na Combo, evento Keypress KeyAscii = Combo_AutoCompletar(combo1, KeyAscii)

Private Sub Form_Unload(Cancel As Integer) If Dir("c:*.tmp") <> "" Then On Error Resume Next Kill "c:*.tmp" End If 'este evento limpa os arquivos .Tmp. Arquivos temporários que são criados e com o passar do tempo vão tomando espaço da memória do PC e pondo esta rotina não precisa ficar procurando e excluindo manualmente tais arquivos.

Máscara De CNPJ No Textbox Colocar no evento chenge: If Len(Text1) = 2 Then Text1 = Text1 + "." Text1.SelStart = 4 End If If Len(Text1) = 6 Then Text1 = Text1 + "." Text1.SelStart = 9 End If If Len(Text1) = 10 Then Text1 = Text1 + "/" Text1.SelStart = 12 End If If Len(Text1) = 15 Then Text1 = Text1 + "-" Text1.SelStart = 17 End If (colocar propriedade maxlengt = 18)

Máscara De Hora No Textbox Colocar no evento change: If Len(Text1) = 2 Then Text51 = Text1 + ":" Text1.SelStart = 4 End If If Len(Text1) = 1 Then Text1 = Text1 + ":" Text1.SelStart = 7 End If (colocar propriedade maxlengt = 8)

Máscara De CPF No Textbox Colocar no evento change: If Len(Text1) = 3 Then Text1 = Text1 + "." Text1.SelStart = 5 End If If Len(Text1) = 7 Then Text1 = Text1 + "." Text1.SelStart = 9 End If If Len(Text1) = 11 Then Text1 = Text1 + "-" Text1.SelStart = 14 End If (colocar propriedade maxlengt = 14)

Máscara De Data No Textbox Colocar no evento change: If Len(Text1) = 2 Then Text1 = Text1 + "/" Text1.SelStart = 4 End If If Len(Text1) = 5 Then Text1 = Text1 + "/" Text1.SelStart = 7 End If obs: (colocar propriedade maxlengt = 10)

Basta colocar no evento GOTFOCUS da caixa de texto: sendkeys "{HOME}+{END}"

coloque num módulo: Inserir um módulo ao Projeto e declarar a conexão no módulo: Public cnnNomedaConexão as New ADODB.Connection Inserir um formSplash colocando nele um timer, informando um valor de no mínimo 1000 na propriedade “interval” e na caixa de comando inserir a conexão com o Banco de Dados: Private Sub Timer1_Timer() On Error GoTo errconexao cnnNomedaConexão.ConnectionString = "provider = microsoft.jet.oledb.4.0;" & _ "data Source = c:\documents and settings\usuario\meus documentos\Project 1\banco.mdb;" cnnNomedaConexão.Open Unload Me Form2.Show Exit Sub errconexao: With Err If .Number <> 0 Then MsgBox " houve um erro na conexão com o banco de dados." & _ vbCrLf & " O sistema será encerrado.", vbCritical + vbOKOnly + vbApplicationModal, "erro na conexão" .Number = 0 Set cnnNomedaConexão = Nothing End End If End With Faça as devidas alterações como: nome de sua conexão, nome e destino de seu banco de dados e o form ou mdi inicial de seu projeto

Manda um email pra mim com o nome de OLE!, que te respondo anexando uma apostila que é só do objeto OLE, e explica passo a passo o que você quer saber e muito mais. beleza? jilney@hotmail.com.