Icon e Título da aplicação e Criar Atalho no Ambiente de Trabalho

Olá a todos, partilho exemplo para:

A) Criar ou alterar Icon e Título da aplicação.

Código:

Private Sub cmdIconTitulo_Click()
'AHTEIXEIRA 2018 para MaximoAccess
On Error GoTo Trata_Erro

    Dim iTrataErr As Integer
    Dim NomeProp, ValorProp As String

    'guarda valor tratamento de erros e altera para modo classe
    iTrataErr = Application.GetOption("Error Trapping")
    Application.SetOption "Error Trapping", 1

    'nome do projeto (base de dados)
    NomeProp = "AppTitle"
    ValorProp = "A minha APP..."     '*** alterar nesta linha ***
    CurrentDb.Properties(NomeProp) = ValorProp
    
    
    'Icon do projeto (base de dados)
    NomeProp = "AppIcon"
    ValorProp = CurrentProject.Path & "\icon.ico"     '*** alterar nesta linha ***
    CurrentDb.Properties(NomeProp) = ValorProp
    
    Application.RefreshTitleBar

    MsgBox "Alteração concluída.", vbInformation, ""

Sair_Sub:
    'repoe valor tratamento erros
    Application.SetOption "Error Trapping", iTrataErr
    Exit Sub
    
Trata_Erro:
    If Err.Number = 3270 Then 'caso nao exista
            Dim AppPrp As Property
            Dim db As Database
            Set db = CurrentDb
            Set AppPrp = db.CreateProperty()
            
            AppPrp.Name = NomeProp
            AppPrp.Type = dbText
            AppPrp.Value = ValorProp
            db.Properties.Append AppPrp
            db.Properties(NomeProp) = ValorProp
            
            Set AppPrp = Nothing
            Set db = Nothing
        Resume Next
    Else
        MsgBox "Erro # " & Err.Number & vbCrLf & vbLf & Err.Description
        Resume Sair_Sub
    End If

End Sub

B) Criar atalho no Ambiente de Trabalho (DeskTop)

Código:

Private Sub cmdCriarAtalho_Click()
'AHTEIXEIRA 2018 para MaximoAccess
    
    Dim oWSH As Object, oAtalho As Object
    Dim sCaminhoDesktop, sAtalho, sCaminhoBD As String
      
    sCaminhoBD = Application.CurrentProject.Path & "\" & Application.CurrentProject.Name   'pode-se alterar por caminhoCompleto\nomeBaseDados.ext
    
    Set oWSH = CreateObject("WScript.Shell")
    sCaminhoDesktop = oWSH.SpecialFolders("Desktop")
    sAtalho = sCaminhoDesktop & "\MinhaAPP.lnk"
    
    Set oAtalho = oWSH.CreateShortcut(sAtalho)
       With oAtalho
          .TargetPath = Chr(34) & SysCmd(9) & "MSACCESS.EXE" & Chr(34)
          .Arguments = Chr(34) & sCaminhoBD & Chr(34)
          .Description = "Descrição da minha APP"
          .WorkingDirectory = Application.CurrentProject.Path
          .IconLocation = Application.CurrentProject.Path & "\" & "icon.ico"   'pode-se alterar por caminhoCompleto\nomeIcon.ico
          .Save
       End With
    
    MsgBox "Atalho criado no Ambiente de Trabalho (Desktop), verifique.", vbInformation, ""
    DoCmd.Quit
    
End Sub

Abraço

muito bom! Parabéns!

Show! vou implementar em minhas palicações!

Obrigado por compartilhar certamente será muito útil.

Abraço.

Obrigado! Resultou na perfeição. Agora só tenho de alterar o código para colocar a aplicação numa pasta diferente do que o desktop... eu infelizmente desenvolvi a aplicação baseando-me sempre no caminho do desktop.. para exportar relatórios, documentos, etc,etc,etc... vou ter agora muito trabalho pela frente para alterar o diretório padrão (desktop) para colocar o executável noutra pasta.

Olá a todos,

Obrigado pelo retorno, é sempre gratificante.

Abraço e bons estudos com o MaximoAccess

Muito bom, bem elaborado, excelente obrigado por partilhar

Muito bom, parabens, vou implementar em minhas aplicações