Anderson Fernandes

Teclando Alt + F11 no seu teclado vai abrir a tela do VBA então você da 2 cliques no icone do lado esquerdo da tela que provavelmente esta com o nome "EstaPasta_de_trabalho" e com um icone parecido com o do Excel. e colocae este código Private Sub Workbook_Open() Dim Aux As Integer Aux = DiasDT(Format(Now(), "dd/MM/yyyy"), Format("09/08/2007", "dd/MM/yyyy")) 'VERIFICA SE A PLANILHA ESTA VENCIDA If Aux >= 0 Then 'EXIBE A QUANTO DIAS ESTA VENCIDO A PLANILHA ' O IIF É SÓ PARA VERIFICAR SE A PLANILHA ESTA VENCIDA A MAIS DE 1 DIA SE SIM EXIBE DIAS 'SE NÃO EXIBE DIA MsgBox "A planilha expirou à " & Aux & " " & IIf(Aux > 1, "dias", "dia") 'FECHA A PLANILHA Me.Close End If End Sub 'FUNÇÃO Public Function DiasDT(DT1 As Date, DT2 As Date) As String DiasDT = DT1 - DT2 End Function AH SÓ PRA LEMBRA QUE VBA TEM UM PROBLEMA SE O USUÁRIO FOR NO MENU FERRAMENTAS/MACRO/SEGURANÇA ELE PODE COLOCAR O NIVEL NO MÉDIO E NA HORA QUE ABRIR ELE SELECIONAR QUE NÃO QUER QUE EXECUTE O SCRIPT

Bom em qual programado Office você quer fazer isso? o sistema começara a contar a quantidade de dias até que expire apartir da data de instalação ou data da 1ª vez que foi aberta ou você que vai estipular a data?

Bom pra saber o numero serial do HD ou CD ou Disquete você pode usar esta função Private Declare Function GetVolumeInformation Lib _ "kernel32" Alias "GetVolumeInformationA" _ (ByVal lpRootPathName As String, ByVal _ lpVolumeNameBuffer As String, ByVal _ nVolumeNameSize As Long, _ lpVolumeSerialNumber As Long, _ lpMaximumComponentLength As Long, _ lpFileSystemFlags As Long, ByVal _ lpFileSystemNameBuffer As String, ByVal _ nFileSystemNameSize As Long) As Long Public Function DriveSerial(ByVal Drive As _ String) As Long 'Valor que retornará o serial do HD Dim RetVal As Long Dim HDNameBuffer As String * 256 'Nome do HD Dim FSBuffer As String * 256 'FS do HD Dim a As Long 'auxiliar Dim b As Long 'auxiliar Call GetVolumeInformation(Drive, HDNameBuffer, _ 256, RetVal, a, b, FSBuffer, 256) DriveSerial = RetVal End Function E pode usala assim MsgBox Hex(DriveSerial("C:\")) você pode usar o Environ para saber qual é a unidade padrão lembrando que esse serial pode mudar ao se formatar o HD e é possivel clonar o HD obtendo o mesmo serial você de estar querendo criar alguma coisa como licença para poder acessar o seu sistema ou planilha né? bom eu to criando um sistema que faz isso ele é mais ou menos assim quando você abre o sistema ele verifica no registro do Windows se você tem uma licença valida se não tiver ele abre uma telinha informando um GUID (Numero randomico universal que não repete) e pede o nome de usuário e tem um outro campo pedindo o numero de série. O numero de serie é criado apenas por mim atravez do GUID, nome de usuario e numero do HD. quando aparece esta tela o usuario clica em um botão "Enviar requisição de licença" onde eu recebo o arquivo com os dados, crio um numero de serie e informo ao usuario que digita e clica em validar fazendo assim o sistema verificar se a chave é verdadeira se for salva no registro os dados inclusive a data de registro. quando o sistema esta licenciado ele verifica a diferença entre datas e o numero do HD se qualquer informação estiver fora do normal ele bloqueia o sistema. bom é mais ou menos isso acho que já deu pra te adiantar alguma coisa eu estou terminando o código acho que na proxima segunda eu já terminei, ai eu te do uma ajuda, beleza! bom mas qualquer urgencia é só postar beleza!!!! Fui!!!

Bom até da pra fazer! Mas não seria mais facil criar consultas com critérios (Tipo Status = 'Devedor', etc). bom no proprio Access tem como você criar consulta inclusão e consulta exclusão, ai é só você criar uma consulta Inclusão para incluir os dados da tab1 para a tab2 e outra consulta Exclusão para excluir os dados da tab1. ai no botão você faz executar executar as 2 consultas. bom vê o que você acha melhor e posta ai pra gente, beleza!!!!

beleza!!!! Deixa eu ver se entendi! você tem uma tabela vinculada que vem do Excel, certo? e você esta em qual programa tentando verificar essa contagem? onde você quer que aparece esse contador? você estaria utilizando o Access você quer que apareça em um campo de um formulario ou em um relatório? pode postar mais detalhes?

Tem como fazer isso sim mas você vai precisar desta consulta pra que? seria pra um relatório ou você gostaria apenas de visualizar como uma planilha? bom se for em um relatório você pode fazer assim: no evento Open (Abrir) você coloca o seguinte código Private Sub Report_Open(Cancel As Integer) 'A propriedade RecordSource é a mesma coisa do que a 'propriedade fonte de registros quando se da dois cliques no relatório 'então é só você criar o select de acordo com sua necessidade Me.RecordSource = "Select * from tab1 where id = 2" End Sub bom qualquer coisa é só postar beleza!

bom eu testei o seu código e ele funcionou só que o que deu a entender pela sua pergunta era outra coisa no seu código você passa o valor a ser pesquisado na combo se existir o valor exato ele seleciona na combo. bom, resolveu seu problema é isso que importa! valeu cara qualquer duvida estamos ai, beleza! Achei interesante este seu código! (Simples porem funcional) bom, apartir do seu código eu criei uma função que eu espero que te ajude em algo! 'Essa é a função 'perceba que a busca é realizada com o operador LIKE Public Function BuscaCbo(Combo As ComboBox, ByVal TextoProc As String) As Boolean Dim intJ As Integer BuscaCbo = False For intJ = 0 To Me.Combo1.ListCount - 1 If Combo.List(intJ) Like TextoProc Then Combo.ListIndex = intJ BuscaCbo = True Exit For End If Next intJ End Function 'Este é um exemplo de uso Private Sub Command1_Click() If BuscaCbo(Me.Combo1, Me.Text1) = False Then MsgBox "Texto não localizado!!!" Else Me.Text1 = Me.Combo1.Text End If End Sub

Opa, valeu mesmo por perguntar em Kuroi! Mas por eu não saber muito tambem sobre arquivos de recursos não surgiram novas duvidas depois que eu li o artigo do macoratti! mas me foi muito interesante este recurso. Vou ver se crio um projetinho pra enviar pro site e pode deixar que asim que surgirem duvidas eu posto sim. Valeu mesmo!!!

Acho que já sei o que acontece, não tenho certeza tente digitar no executar regsvr32 "C:\Arquivos de programas\Arquivos comuns\Microsoft Shared\DAO\dao360.dll" com as aspas (") você deve ter digitado sem aspas então ele reconheceu apenas C:\Arquivos como se fosse o nome do arquivo e o resto como parametros, como a propria messagem apresenta. beleza!

Bom, você verificou se a Dll esta neste local exeato no seu micro? se esta, seu usuario tem permição de administrador na maquina?

você já tentou fazer isto? Private Sub Combo1_Change() Me.Text1 = Me.Combo1.Text End Sub Private Sub Combo1_Click() Me.Text1 = Me.Combo1.Text End Sub

beleza! você tem que registrar a dll que esta em: C:\Arquivos de programas\Arquivos comuns\Microsoft Shared\DAO\dao360.dll caso ela exista no seu micro é claro para registrar va em Iniciar e em executar no Windows e digite regsvr32 C:\Arquivos de programas\Arquivos comuns\Microsoft Shared\DAO\dao360.dll e ela aparecera em referencias

Opa, beleza! deixa eu ver se entendi você quer saber qual é o texto de uma ComboBox, certo? mas você quer saber o texto atual ou seja o texto que estiver selecionado ou você quer verificar se existe na lista da combobox um texto?

aqui tambem é possivel usar a instrução LIKE tipo: Adodc1.Recordset.Find "campo like '*" & Text20.Text & "*'"

bom antes de abrir o RS tente fazer isto msgbox StringSQL para vizualizar o select para verificar se esta certo e no lugar da % tente usar *

Eu sei mais ou menos pra que serve, mas não sei como criar e como utilizar estes arquivos Eu tenho um projeto que deixa o VB com a aparencia do XP para este projeto funcionar ele depende de um arquivo XML que tem que ser salvo no mesmo local do EXE e com o mesmo nome e extensão do aplicativo .manifest tipo aplicação.exe.manifest. Eu encontre na net um projeto que faz a mesma coisa só que usa no lugar do arquivo XML ele usa um arquivo *.res dentro do projeto. Eu tentei abrir este arquivo .res com o bloco de notas e percebi que tem alguns comandos XML só que parace ser um arquivo binario não sei. A vantagem deste 2º projeto é que ele não depende de nenhum arquivo após ter sido copilado para funcionar. Eu pesso uma ajuda para entender um pouquinho mais sobre os arquivos RES Como criar e como usar ou onde eu encontro algo sobre isto. Desde já eu agradeço!!!! já encontrei algumas coisas na net que tirou minhas duvidas. Pra quem se interesar o site é este: http://www.macoratti.net/recursos.htm

Bom no VB6 é só fazer assim WebBrowser1.Navigate "http://www.endereco.com.br"

Ou você pode estar criando um array com os boões se tiver duvida é só postar, beleza Se bem que... agora que o seu projeto já esta pronto seje mais facil usar a forma do Kuroi mesmo, beleza

Aqui no site da ScriptBrasil já existe alguns projetos prontos Web Browser usando o iframe e se você procurar aqui no forum existe um tópico de com criar um Web Browser com um componente da Mozila (Embora o iframe seje melhor). Bom eu tenho um projeto que eu fiz bem interesante com Favoritos e histórico! vou ver se eu encontro e te envio beleza!

Eu concegui se conectar ao AD, mas não sei quais tabelas existem para que eu possa fazer o SELECT aqui ta o script para se conectar ao AD (Active Directory) é necessario fazer referencia ao Microsoft ActiveX 2.0 Dim DB As New Connection Dim RS As New Recordset Private Sub Command1_Click() DB.Open "Provider=ADSDSOObject;" MsgBox DB.State End Sub a msgbox até retorna o valor 1 ou seja esta conectado e para abrir o RS estou tentando isso RS.Open "SELECT * From 'LDAP://DC=microsoft, DC=COM'", DB, 1, 3 no lugar de microsoft já tentei colocar o dominio da empresa(lark.com.br), o nome do servidor(lark_srv.lark.com.br) e o nome de uma pasta que tem usuarios mas da erro dizendo TABELA INEXISTENTE. não tenho certeza se o select esta correto ('LDAP;//DC=...). "QUERO SABER COMO FAÇO O SELECT CORRETO" se alguém poder me dar uma ajuda eu agradeço!

Faça referencia ao: Microsoft ActiveX Data Objects 2.0 Library Em um Módulo Faça: '--------------------------------------------------------------------------------- Option Explicit Public DB As ADODB.Connection Sub Conexao(Fonte As String, Senha as String) On Error GoTo Err_Conexao If (DB Is Nothing) Then Set DB = New ADODB.Connection Else If DB.State = 1 Then DB.Close End If End If With DB .CursorLocation = adUseClient .Provider = "Microsoft.Jet.OLEDB.4.0" .Properties("Data Source") = Fonte .Properties("Jet OLEDB:Database Password") = Senha .Open End With Exit Sub Err_Conexao: MsgBox "Erro ao se conectar com o banco de dados", vbCritical, "Erro!" End Sub '--------------------------------------------------------------------------------- Em um form: Option Explicit Dim RS As New Recordset Private Sub Form_Load() call Conexao("C:\Banco.mdb","") End Sub Private Sub CmdPesquisar_Click() If RS.State = 1 Then RS.Close RS.Open "SELECT * FROM TABELA WHERE CAMPO1 = CONDIÇÃO", DB, 1, 3 'Script para preencher um listview com os dados encontrados 'Digamos que o seu listview tem o nome Lst1 Lst1.clear RS.MoveFirst Do while Rs.EOF = false Lst1.additem RS!Campo1 loop End Sub E pronto!!! Simples Assim! Qualquer duvida é só postar beleza!

Estou criando um sisteminha integrado que o usuário pode abrir chamados, tem Agenda telefonica, inventário de Softwares e Hardwares e etc. Bom na realidade é um Serviço Windows, está funcionando beleza, porem aparece no gerenciador de tarefas na aba de aplicativos e na aba de processos esta ok não aparece. Obs: Alguns usuários tem Windows XP e outros o 2000 Valeu pessoal!

Agora eu testei e deu certo em! Bom para aparecer a lista como a proriedade appearence é só colocar um script basicamente assim na OCX Option Explicit Public Enum tCasas Zero = 0 Uma = 1 Duas = 2 Tres = 3 Quatro = 4 End Enum Private pCasas As Integer Public Property Get Casas() As tCasas Casas = pCasas End Property Public Property Let Casas(ByVal NewValue As tCasas) pCasas = NewValue PropertyChanged "Casas" 'EXECUTA O SCRIPT COM O VALOR RECEBIDO End Property Espero que seja isso! Mas qualquer coisa é só postar, se bem que a essas alturas você já deve ter conceguido, rs! Até mais!!!

Opa!! La vai o código! em um ClassModule Option Explicit ' ' Win32 Registry functions ' Private Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As Any, phkResult As Long, lpdwDisposition As Long) As Long Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value. Private Declare Function RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hKey As Long, ByVal lpClass As String, lpcbClass As Long, lpReserved As Long, lpcSubKeys As Long, lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, lpcValues As Long, lpcbMaxValueNameLen As Long, lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, lpftLastWriteTime As Any) As Long Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, lpcbName As Long, lpReserved As Long, ByVal lpClass As String, lpcbClass As Long, lpftLastWriteTime As Any) As Long Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value. Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long ' ' Constants for Windows 32-bit Registry API ' Private Const HKEY_CLASSES_ROOT = &H80000000 Private Const HKEY_CURRENT_USER = &H80000001 Private Const HKEY_LOCAL_MACHINE = &H80000002 Private Const HKEY_USERS = &H80000003 Private Const HKEY_PERFORMANCE_DATA = &H80000004 Private Const HKEY_CURRENT_CONFIG = &H80000005 Private Const HKEY_DYN_DATA = &H80000006 ' ' Reg result codes ' Private Const REG_CREATED_NEW_KEY = &H1 ' New Registry Key created Private Const REG_OPENED_EXISTING_KEY = &H2 ' Existing Key opened ' ' Reg Create Type Values... ' Private Const REG_OPTION_RESERVED = 0 ' Parameter is reserved Private Const REG_OPTION_NON_VOLATILE = 0 ' Key is preserved when system is rebooted Private Const REG_OPTION_VOLATILE = 1 ' Key is not preserved when system is rebooted Private Const REG_OPTION_CREATE_LINK = 2 ' Created key is a symbolic link Private Const REG_OPTION_BACKUP_RESTORE = 4 ' open for backup or restore ' ' Reg Key Security Options ' Private Const DELETE = &H10000 Private Const READ_CONTROL = &H20000 Private Const WRITE_DAC = &H40000 Private Const WRITE_OWNER = &H80000 Private Const SYNCHRONIZE = &H100000 Private Const STANDARD_RIGHTS_READ = (READ_CONTROL) Private Const STANDARD_RIGHTS_WRITE = (READ_CONTROL) Private Const STANDARD_RIGHTS_EXECUTE = (READ_CONTROL) Private Const STANDARD_RIGHTS_REQUIRED = &HF0000 Private Const STANDARD_RIGHTS_ALL = &H1F0000 Private Const SPECIFIC_RIGHTS_ALL = &HFFFF Private Const KEY_QUERY_VALUE = &H1 Private Const KEY_SET_VALUE = &H2 Private Const KEY_CREATE_SUB_KEY = &H4 Private Const KEY_ENUMERATE_SUB_KEYS = &H8 Private Const KEY_NOTIFY = &H10 Private Const KEY_CREATE_LINK = &H20 Private Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE)) Private Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE)) Private Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE)) Private Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE)) Private Const ERROR_SUCCESS = 0& Private Const ERROR_MORE_DATA = 234 Private Const ERROR_NO_MORE_ITEMS = 259 Private Const REG_SZ = 1 ' Unicode nul terminated string ' ' Private member variables ' Private m_Company As String Private m_AppName As String ' ' Private class constants ' Private Const defCompany As String = "VB and VBA Program Settings" ' ******************************************** ' Initialize and Terminate ' ******************************************** Private Sub Class_Initialize() m_Company = defCompany m_AppName = App.ProductName End Sub ' ******************************************** ' Public Properties ' ******************************************** Public Property Let Company(ByVal NewVal As String) If Len(NewVal) Then m_Company = Trim(NewVal) Else m_Company = defCompany End If End Property Public Property Get Company() As String Company = m_Company End Property Public Property Let AppName(ByVal NewVal As String) If Len(NewVal) Then m_AppName = Trim(NewVal) Else m_AppName = App.ProductName End If End Property Public Property Get AppName() As String AppName = m_AppName End Property ' ******************************************** ' Public Methods ' ******************************************** Public Function DeleteSetting(ByVal Section As String, Optional ByVal Key As String = "") As Boolean ' Section Required. String expression containing the name of the section where the key setting ' is being deleted. If only section is provided, the specified section is deleted along ' with all related key settings. ' Key Optional. String expression containing the name of the key setting being deleted. Dim nRet As Long Dim hKey As Long If Len(Key) Then ' Open key nRet = RegOpenKeyEx(HKEY_CURRENT_USER, SubKey(Section), 0&, KEY_ALL_ACCESS, hKey) If nRet = ERROR_SUCCESS Then ' Set appropriate value for default query If Key = "*" Then Key = vbNullString ' Delete the requested value nRet = RegDeleteValue(hKey, Key) Call RegCloseKey(hKey) End If Else ' Open parent key nRet = RegOpenKeyEx(HKEY_CURRENT_USER, SubKey(), 0&, KEY_ALL_ACCESS, hKey) If nRet = ERROR_SUCCESS Then ' Attempt to delete whole section nRet = RegDeleteKey(hKey, Section) Call RegCloseKey(hKey) End If End If DeleteSetting = (nRet = ERROR_SUCCESS) End Function Public Function GetAllSettings(ByVal Section As String) As Variant ' Section Required. String expression containing the name of the section ' to enumerate. Dim nRet As Long Dim hKey As Long Dim nMaxValueNameLen As Long Dim nMaxValueLen As Long Dim nValueNameLen As Long Dim nValueLen As Long Dim nType As Long Dim nIndex As Long Dim nStrings As Long Dim ValueName As String Dim Value As String Dim Values() As String Dim Results() As String Dim i As Long ' Open key nRet = RegOpenKeyEx(HKEY_CURRENT_USER, SubKey(Section), 0&, KEY_READ, hKey) If nRet = ERROR_SUCCESS Then ' Get a quick snapshot of what we're facing. nRet = RegQueryInfoKey(hKey, vbNullString, ByVal 0&, ByVal 0&, ByVal 0&, ByVal 0&, ByVal 0&, ByVal 0&, nMaxValueNameLen, nMaxValueLen, ByVal 0&, ByVal 0&) If nRet = ERROR_SUCCESS Then ' Allocate buffers. ValueName = Space(nMaxValueNameLen + 1) Value = Space(nMaxValueLen + 1) ' Get value names and associated values. Do nValueNameLen = Len(ValueName) nValueLen = Len(Value) nRet = RegEnumValue(hKey, nIndex, ValueName, nValueNameLen, ByVal 0&, nType, ByVal Value, nValueLen) If nRet = ERROR_SUCCESS Then ' Only return string values. If nType = REG_SZ Then ReDim Preserve Values(0 To 1, 0 To nStrings) As String Values(0, nStrings) = Left$(ValueName, nValueNameLen) Values(1, nStrings) = Left$(Value, nValueLen - 1) nStrings = nStrings + 1 End If nIndex = nIndex + 1 Else 'ERROR_NO_MORE_ITEMS Exit Do End If Loop ' Transpose array to match VB's output, and ' return Results if any were obtained. If nStrings >= 1 Then ReDim Results(0 To nStrings - 1, 0 To 1) As String For i = 0 To nStrings - 1 Results(i, 0) = Values(0, i) Results(i, 1) = Values(1, i) Next i GetAllSettings = Results End If End If Call RegCloseKey(hKey) End If End Function Public Function GetSetting(ByVal Section As String, ByVal Key As String, Optional ByVal Default As String = "") As String ' Section Required. String expression containing the name of the section where the key setting is found. ' If omitted, key setting is assumed to be in default subkey. ' Key Required. String expression containing the name of the key setting to return. ' Default Optional. Expression containing the value to return if no value is set in the key setting. ' If omitted, default is assumed to be a zero-length string (""). Dim nRet As Long Dim hKey As Long Dim nType As Long Dim nBytes As Long Dim Buffer As String ' Assume failure and set return to Default GetSetting = Default ' Open key nRet = RegOpenKeyEx(HKEY_CURRENT_USER, SubKey(Section), 0&, KEY_READ, hKey) If nRet = ERROR_SUCCESS Then ' Set appropriate value for default query If Key = "*" Then Key = vbNullString ' Determine how large the buffer needs to be nRet = RegQueryValueEx(hKey, Key, 0&, nType, ByVal Buffer, nBytes) If nRet = ERROR_SUCCESS Then ' Build buffer and get data If nBytes > 0 Then Buffer = Space(nBytes) nRet = RegQueryValueEx(hKey, Key, 0&, nType, ByVal Buffer, Len(Buffer)) If nRet = ERROR_SUCCESS Then ' Trim NULL and return successful query! GetSetting = Left(Buffer, nBytes - 1) End If End If End If Call RegCloseKey(hKey) End If End Function Public Function SaveSetting(ByVal Section As String, ByVal Key As String, ByVal Setting As String) As Boolean ' Section Required. String expression containing the name of the section where the key setting is being saved. ' Key Required. String expression containing the name of the key setting being saved. ' Setting Required. Expression containing the value that key is being set to. Dim nRet As Long Dim hKey As Long Dim nResult As Long ' Open (or create and open) key nRet = RegCreateKeyEx(HKEY_CURRENT_USER, SubKey(Section), 0&, vbNullString, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, ByVal 0&, hKey, nResult) If nRet = ERROR_SUCCESS Then ' Set appropriate value for default query If Key = "*" Then Key = vbNullString ' Null-terminate setting, in case it's empty. ' Strange mirroring can occur otherwise. Setting = Setting & vbNullChar ' Write new value to registry nRet = RegSetValueEx(hKey, Key, 0&, REG_SZ, ByVal Setting, Len(Setting)) Call RegCloseKey(hKey) End If SaveSetting = (nRet = ERROR_SUCCESS) End Function ' ******************************************** ' Private Methods ' ******************************************** Private Function SubKey(Optional ByVal Section As String = "") As String ' Build SubKey from known values SubKey = "Software\" & m_Company & "\" & m_AppName If Len(Section) Then SubKey = SubKey & "\" & Section End If End Function Em um form coloque 5 TextBox e 4 Botões com os captions: SaveSetting, DeleteSetting, GetSetting e GetAllSettings não altere os names la vai o código do form Option Explicit Private reg As CRegSettings Private Sub Command1_Click() reg.SaveSetting Text3.Text, Text4.Text, Text5.Text End Sub Private Sub Command2_Click() reg.DeleteSetting Text3.Text, Text4.Text End Sub Private Sub Command3_Click() Text5.Text = reg.GetSetting(Text3.Text, Text4.Text, "(nada)") End Sub Private Sub Command4_Click() Dim dat As Variant Dim msg As String Dim i As Long Const msgTitle = "GetAllSettings Results" ' The VB way... 'dat = GetAllSettings("API Viewer", "Position") ' The CRegSettings way... 'reg.Company = "VB and VBA Program Settings" 'reg.AppName = "API Viewer" 'dat = reg.GetAllSettings("Position") ' The way this demo works... dat = reg.GetAllSettings(Text3.Text) ' Iterate return and display... On Error GoTo NoData For i = 0 To UBound(dat, 1) msg = msg & dat(i, 0) & " = " & dat(i, 1) & vbCrLf Next i MsgBox msg, , msgTitle Exit Sub NoData: MsgBox "No data was returned, or section not found.", , msgTitle End Sub Private Sub Form_Load() Set reg = New CRegSettings ' Typically, these fields would be set once and ' remain the same throughout the app. reg.Company = "VBPJ Examples" reg.AppName = "Reg Replacement Test" ' Display "fixed" settings, and hint what to ' enter in the other fields. Text1.Text = reg.Company Text2.Text = reg.AppName Text3.Text = "(section)" Text4.Text = "(key)" Text5.Text = "(value)" Set Me.Icon = Nothing End Sub Beleza! Agora é só executar! se der algum erro é só falar e se algem atravez deste Script ou de outro puder me ajudar com minha duvida AGRADEÇO!!!

Bom dia a todos! Eu sei como pegar o Value de uma Key ou até mesmo todas as Key de uma Section do registro mas como são varias Sections tipo: HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\RealVNC_is1\DisplayName HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\eMule\DisplayName Como eu faço para retornar todas essas Sections? Tipo: SECTION........................KEY......................VALUE RealVNC_is1..................DisplayName...........VNC Free Edition 4.1.2 eMule............................DisplayName............eMule Se quiser eu posto o código ou envio o projeto! Valeu!!!!!!!!!!