IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)



Auteur : Fabby69
Version : 27/08/2004
BO - Importer des Données de Business Objects dans des tables Access
Versions : 97 et supérieures

Cette fonction permet d'importer des données directement d'un Rapport BO via un fichier texte, c'est très pratique et rapide

Private appBO As busobj.Application Private docBO As busobj.Document Private repBO As busobj.Report Function Fct_ImportBO_Access(ByVal Nom_Table As String, _ ByVal Chemin_Req_BO As String, ByVal Chemin_Fich_txt As String) '*************************************************** '************ Ouverture de BO ********************** '*************************************************** 'Initialisation de l'application BO Set appBO = New busobj.Application 'BO accepte les actions d'un utilisateur distant appBO.Interactive = True 'Connexion à l'application BO avec le login et le mot de passe appBO.LoginAs "LOGIN", "PASSWORD", False 'Afficher la fenêtre BO appBO.Visible = True '-------------------- Calcul dates ------------------------------------------------ 'Valeur d'invite BO Dim datDB datDB = Now - 30 'Valeur d'invite BO Dim datFIN datFIN = Now - 2 '*************************************************** '************ Lancement d'une requête BO *********** '*************************************************** 'Définition de la requête BO à ouvrir grâce à son emplacement Set docBO = appBO.Documents.Open(Chemin_Req_BO) 'renseigne les valeurs de l'invite BO docBO.Variables.Item("DB").Value = datDB docBO.Variables.Item("FIN").Value = datFIN 'L'utilisateur ne peut plus affecter l'application et le report BO ouvert appBO.Interactive = False 'Rafraîchissement des données du Report BO docBO.Refresh 'Sélection du rapport (onglet) Set repBO = docBO.Reports.Item(1) 'Export au format texte dans le fichier dont le nom est en paramètre repBO.ExportAsText (Chemin_Fich_txt) '*************************************************** '************ Fermeture de BO ********************** '*************************************************** 'Fermeture du Report docBO.Close 'Fermeture de l'application BO appBO.Quit 'Réinitialisation des données Set docBO = Nothing Set repBO = Nothing Set appBO = Nothing '*************************************************** '************ Import du fichier .txt *************** '*************************************************** 'Import du fichier texte dont le chemin est en paramètre dans la table DoCmd.TransferText acImportDelim, "BO_Spécification_importation", _ Nom_Table, Chemin_Fich_txt placée en paramètre aussi End Function

Auteur : Macno
Auteur : Tofalu
Version : 05/03/2005
Outlook - Créer des rendez-vous dans un calendrier.
Versions : 2000 et supérieures

Cette fonction crée un rendez vous dans un calendrier Outlook. Elle nécessite la référence Microsoft Outlook Object Library.

Public Function CreerRendezVous(PCalendrier As String, _ PDate As String, _ PHeure As String, _ PDuree As Integer, _ PSubject As String, _ PNotes As String, _ PLieu As String, _ Optional PMinutesRappel As Integer = 0) On Error GoTo Add_Err Dim objOutlook As Outlook.Application Dim objAppt As Outlook.AppointmentItem Dim olns As Outlook.NameSpace Dim MycalendarFolder As Outlook.MAPIFolder Dim MyFolder As Outlook.Items Set objOutlook = CreateObject("Outlook.Application") Set olns = objOutlook.GetNamespace("MAPI") Set MycalendarFolder = olns.GetDefaultFolder(olFolderCalendar) 'Selectionne le calendrier 'Selectionne le calendrier If PCalendrier = "" Then Set MyFolder = MycalendarFolder.Items Else Set MyFolder = MycalendarFolder.Folders(PCalendrier).Items End If Set objAppt = MyFolder.Add 'Cree le rendez vous With objAppt If PDuree > 0 Then .Start = PDate & " " & PHeure .Duration = PDuree Else .Start = PDate .AllDayEvent = True End If .Subject = PSubject .Body = PNotes .Location = PLieu 'Ajoute le rappel If PMinutesRappel > 0 Then .ReminderMinutesBeforeStart = PMinutesRappel .ReminderSet = True End If 'Sauvegarde et ferme .SAVE .Close (olSave) End With 'Libération des variables. Set objAppt = Nothing Set objOutlook = Nothing MsgBox "Rdv ajouté!" Exit Function 'Gere les erreurs Add_Err: MsgBox "Error " & Err.Number & vbCrLf & Err.Description End Function
Informations sur les paramètres :

  • PCalendrier : Le nom du calendrier concerné. Passez une chaine vide pour utiliser le calendrier par défaut
  • PDate : La date du rendez vous.
  • PHeure : L'heure du rendez vous.
  • PDuree : La durée du rendez vous en minutes. Utilisez 0 pour que le rendez vous dure toute la journée.
  • PSubject : L'objet du rendez vous.
  • PNotes : Un court résumé du rendez vous.
  • PLieu : Le lieu du rendez vous.
  • PMinutesRappel : Le nombre de minutes avant un rappel. Ne pas renseigner ce paramètre si vous ne souhaitez pas utiliser le rappel Outlook.

Exemple d'insertion d'un rendez vous :

CreerRendezVous "Cal2", "25/02/2005", _ "14:00", 53, "Test", "Ceci est un test", _ "Gare de l'Est", 5
Ceci crée un rendez vous dans le calendrier nommé Cal2. Le rendez vous a lieu le 25 février 2005 à 14h00 à la Gare de l'Est et dure 53 minutes. Outlook me préviendra 5 minutes avant le rendez vous.


Auteur : HervéGermain
Version : 28/01/2005
Lotus - Envoyer un message d'alerte depuis acces via Lotus
Versions : 97 et supérieures

Function SendNotesMsg(ByVal sSendTo As Variant, Optional ByVal sSubject As String, _ Optional ByVal sBodyText As String, _ Optional ByVal sAttachment) As Long '******************************************************************************** '******************************************************************************** 'Objet : Envoie un message par Notes mail 'Arguments: ' sSendTo (Recquis)- un mot représentant le nom du destinataire ' ou un tableau de noms de destinataires ' Si on doit utiliser de multiples destinataires, alors ' sSendTo to doit être passé comme un tableau ' sSubject (Optionel)-la variable littérale à utiliser comme sujet du mail 'sBodyText (Optionel)-la variable littérale à utiliser comme corps du message 'sAttachment (Optionel)-la variable contenant le chemin et le nom du fichier ' attaché s'il existe ' Syntaxe SendNotesMsg "MonNom", "C'est le sujet", "Le texte","C:\data\mondoc.doc" '******************************************************************************* '******************************************************************************* Dim oSess As Object Dim oDB As Object Dim oDoc As Object Dim oItem As Object Dim ntsServer As String Dim ntsMailFile As String 'Utiliser les constantes des lignes suivantes au lieu des 2 lignes précédentes 'seulement si le codage du serveur et le nom du fichier de mailing 'utilisent des variables vides pour ntsServer et s'il s'agit d'une base locale '***************************************************************************** ' Const ntsserver = "notes46/pchelps46" ' Const ntsmailFile = "mail\bhartman.nsf" '***************************************************************************** On Error GoTo err_SendNotesMsg Set oSess = CreateObject("Notes.NotesSession") 'Ne pas utiliser les 2 suivantes en cas d'utilisation des constantes 'gets server name ntsServer = oSess.GetEnvironmentString("MailServer", True) 'Acquière le nom du fichier mailfile de l'utilisateur courant dans Notes.ini ntsMailFile = oSess.GetEnvironmentString("MailFile", True) Set oDB = oSess.GetDatabase(ntsServer, ntsMailFile) Set oDoc = oDB.CreateDocument Set oItem = oDoc.CreateRichTextItem("BODY") oDoc.Form = "Memo" If Not IsMissing(sSubject) Then If sSubject <> "" Then oDoc.Subject = sSubject End If If Not IsMissing(sSubject) Then If sBodyText <> "" Then oDoc.body = sBodyText End If oDoc.FROM = oSess.CommonUserName oDoc.PostedDate = Date If Not IsMissing(sAttachment) Then If sAttachment <> "" Then Call oItem.EmbedObject(1454, "", sAttachment) End If 'Envoie le message Call oDoc.Send(False, sSendTo) SendNotesMsg = 0 MsgBox "Le message a été envoyé", vbInformation exit_SendNotesMsg: On Error Resume Next Set oSess = Nothing Set oDB = Nothing Set oDoc = Nothing Set oItem = Nothing Exit Function err_SendNotesMsg: SendNotesMsg = err.Number If err.Number = 7225 Then MsgBox "Impossible d'attacher le fichier, vérifier le chemin!", vbCritical Else MsgBox "[" & err.Number & "]: " & err.Description End If MsgBox "Message non envoyé suite erreur!", vbCritical Resume exit_SendNotesMsg End Function
On appelle la fonction par une Sub

Private Sub Commande237_Click() Dim strBody As String strBody = "Vous avez la FI N° " & Me.NNO & " à signer " If Me.NNO <> "" Then SendNotesMsg "Destinataire/chemin", "Fiches d'intervention", strBod End If End Sub

Auteur : Argyronet
Version : 05/03/2005
Page de l'auteur
Lotus - Préparer/Envoyer un message via Lotus Notes avec option de sauvegarde.
Versions : 97 et supérieures

Lorsque le client de messagerie est Lotus Notes, vous pouvez créer un formulaire personnalisé avec un look "Outlookien", à savoir zones de destinataires, pièces jointes, zone de message... Un petit bouton pour envoyer et c'est tout.

Procédure globale:

Public Sub SendNotesMail(ByVal Subject As String, _ ByVal Attachment As String, ByVal RECIPIENT As String, _ ByVal CC As String, ByVal BCC As String, _ ByVal BodyText As String, ByVal SaveIt As Boolean) Dim oMaildb As Object Dim oMailDoc As Object Dim oAttachME As Object Dim oSession As Object Dim oEmbedObj As Object Dim sUserName As String Dim sMailDbName As String Const STR_ATTACHMENT As String = "Attachment" On Error GoTo L_ErrCannotCreateNotesSession Set oSession = CreateObject("Notes.NotesSession") sUserName = oSession.sUserName sMailDbName = Left$(sUserName, 1) & Right$(sUserName, _ (Len(sUserName) - InStr(1, sUserName, " "))) & ".nsf" DoEvents lblStatus.Caption = "Information about sender..." Call Sleep(1000) Set oMaildb = oSession.GETDATABASE(vbNullString, _ sMailDbName) If oMaildb.IsOpen = True Then Else oMaildb.OPENMAIL End If Set oMailDoc = oMaildb.CREATEDOCUMENT oMailDoc.Form = "Memo" oMailDoc.SENDTO = RECIPIENT If Len(CC) = 0 Then Else oMailDoc.CopyTo = BC End If If Len(BCC) = 0 Then Else oMailDoc.blindCopyTo = BCC End If oMailDoc.Subject = Subject oMailDoc.Body = BodyText oMailDoc.SAVEMESSAGEONSEND = SaveIt DoEvents lblStatus.Caption = "Looking for attached files..." Call Sleep(1000) If Attachment <> vbNullString Then Set oAttachME = oMailDoc.CREATERICHTEXTITEM_ (STR_ATTACHMENT) Set oEmbedObj = oAttachME.EMBEDOBJECT(1454, _ vbNullString, Attachment, STR_ATTACHMENT) oMailDoc.CREATERICHTEXTITEM _ (STR_ATTACHMENT) End If DoEvents oMailDoc.PostedDate = Now() 'To send the message, remove the quotes characters (') near each line ' lblStatus.Caption = "Sending message..." ' Call Sleep(1000) ' ' oMailDoc.SEND 0, RECIPIENT ' lblStatus.Caption = "Message sent" ' MsgBox "Your message has been sent successfully...", 64, "End" L_ExCannotCreateNotesSession: Set oMaildb = Nothing Set oMailDoc = Nothing Set oAttachME = Nothing Set oSession = Nothing Set oEmbedObj = Nothing Exit Sub L_ErrCannotCreateNotesSession: Select Case Err Case 429 MsgBox "Impossible de localiser un Client Notes; " & _ "Votre message n'a pas été envoyé !", 16, _ "Lotus Notes requis" Case Else MsgBox "Un erreur a empêché l'envoi du message." & _ vbCrlf & "Veuillez en référer à votre administrateur " & _ "pour lui soumettre cette erreur..." & vbCrlf & Error ,_ 16, "Error #" & Str(Err) End Select Resume L_ExCannotCreateNotesSession End Sub
Mode d'utilisation:

Sub CreateMemoNotes() SendNotesMail Me!txtSubject, Me!txtAttachment, Me!txtTo, _ Me!txtCC, Me!txtCCC, Me!txtMessage, False End Sub
Petit plus: Me!txtAttachment représente une ligne de chemin complet avec un nom de fichier valide séparé par le séparateur de CommonDialog Control. (La virgule en théorie). Dans le Formulaire où j'avais exploité ce code, j'avais utilisé un GetOpenFileName() commandé par petit bouton à 3 points (Parcourir...) et qui autorisait une sélection multiple de fichiers.

Déclaration de l'API (A placer en haut de module) :

Private Declare Function GetOpenFileName Lib _ "comdlg32.dll" Alias "GetOpenFileNameA" _ (pOpenfilename As OPENFILENAME) As Long Private Type OPENFILENAME lStructSize As Long hwndOwner As Long hInstance As Long lpstrFilter As String lpstrCustomFilter As String nMaxCustFilter As Long nFilterIndex As Long lpstrFile As String nMaxFile As Long lpstrFileTitle As String nMaxFileTitle As Long lpstrInitialDir As String lpstrTitle As String flags As Long nFileOffset As Integer nFileExtension As Integer lpstrDefExt As String lCustData As Long lpfnHook As Long lpTemplateName As String End Type Private Const OFN_READONLY = &H1 Private Const OFN_OVERWRITEPROMPT = &H2 Private Const OFN_HIDEREADONLY = &H4 Private Const OFN_NOCHANGEDIR = &H8 Private Const OFN_SHOWHELP = &H10 Private Const OFN_ENABLEHOOK = &H20 Private Const OFN_ENABLETEMPLATE = &H40 Private Const OFN_ENABLETEMPLATEHANDLE = &H80 Private Const OFN_NOVALIDATE = &H100 Private Const OFN_ALLOWMULTISELECT = &H200 Private Const OFN_EXTENSIONDIFFERENT = &H400 Private Const OFN_PATHMUSTEXIST = &H800 Private Const OFN_FILEMUSTEXIST = &H1000 Private Const OFN_CREATEPROMPT = &H2000 Private Const OFN_SHAREAWARE = &H4000 Private Const OFN_NOREADONLYRETURN = &H8000 Private Const OFN_NOTESTFILECREATE = &H10000 Private Const OFN_NONETWORKBUTTON = &H20000 Private Const OFN_NOLONGNAMES = &H40000 Private Const OFN_EXPLORER = &H80000 Private Const OFN_NODEREFERENCELINKS = &H100000 Private Const OFN_LONGNAMES = &H200000
Fonction d'affichage de la boîte de dialogue des fichiers à joindre

Public Function fnctGetAttachedFiles(ByVal InitialDir _ As String, ByVal Extensions As String, _ ByVal ApplicationName As String) As String Const MIN_PATH As Integer = 260 Const MAX_PATH As Integer = 8192 Dim oOFN As OPENFILENAME Dim lReturn As Long Dim sFilter As String Dim sAttachmentString As String Dim aApplications() As String Dim aExtensions() As String Dim I As Integer aApplications = Split(ApplicationName, ";") aExtensions = Split(Extensions, ";") For I = LBound(aApplications) To UBound(aApplications) sFilter = sFilter & "Fichiers " & aApplications(I) & _ vbNullChar & aExtensions(I) & vbNullChar Next With oOFN .lStructSize = Len(oOFN) .hwndOwner = Application.hWndAccessApp .lpstrFile = Extensions .lpstrFilter = sFilter .nFilterIndex = 1 .lpstrFile = String(MIN_PATH, 0) .flags = OFN_LONGNAMES Or OFN_HIDEREADONLY _ Or OFN_ALLOWMULTISELECT .nMaxFile = IIf((.flags And OFN_ALLOWMULTISELECT) = _ OFN_ALLOWMULTISELECT, MAX_PATH, MIN_PATH - 1) .lpstrFileTitle = .lpstrFile .nMaxFileTitle = .nMaxFile .lpstrInitialDir = IIf(Len(InitialDir) = 0, _ Left(Application.CurrentProject.Path, 3), InitialDir) .lpstrTitle = "Sélection de fichiers en pièces jointes" End With lReturn = GetOpenFileName(oOFN) sAttachmentString = oOFN.lpstrFile If InStr(1, sAttachmentString, vbNullChar) Then sAttachmentString = Trim(Left(sAttachmentString, _ InStr(1, sAttachmentString, vbNullChar) - 1)) End If fnctGetAttachedFiles = sAttachmentString End Function
Code à affecter au bouton Parcourir...

Sub ShowFileDialog() Dim sAttachmentString As String sAttachmentString = fnctGetAttachedFiles("D:\Data", _ "*.doc;*.xls;*.mdb;*.txt", "Word;Excel;Access;Notepad") If Len(sAttachmentString) > 0 Then Me!txtAttachment = sAttachmentString Else Me!txtAttachment = vbnulstring End If End Sub

Auteur : Obipadawan
Auteur : Lucifer
Version : 27/08/2004
Word - Exporter des données vers un document
Versions : 97 et supérieures

Grâce au forum j'ai pu résoudre mon probleme d'exportation vers word. Je trouve cette solution, peut être plus longue que le publipostage, mais moins lourde pour les fichiers word générés. pour le titre et l'auteur désolé, je ne me souviens plus, je vous donne ici le code modifié pour mes besoins, mais applicable facilement. il s'agit d'un code pour piloter word depuis access en ouvrant un document et en y "collant" les données du formulaire. A noter que dans le document word il faut insérer des bookmarks en leur donnant le même nom que le champ que l'on veut exporter. Pour simplifier : le bookmark "données" = données.value !

Private Sub CmdWORD_Click() 'Voici pour la déclaration du code: Dim wdapp As Word.Application Dim moncode moncode = code.Value 'Démarrer Word Set wdapp = CreateObject("Word.application") ' le code ci-dessous permet de faire apparaitre word ' en premier plan ou pas, false -> non et true -> oui wdapp.Visible = False 'on ouvre le document wdapp.Documents.Open "j:\Doc_Atelier\td138\td138_gdt.doc" ' avant d'affecter la valeur du champ code au signet code, ' je teste si le champ code est vide, 'car si oui cela posera probleme et dans ce cas j'affecte la valeur "." If code.Value <> "" Then wdapp.ActiveDocument.Bookmarks("code").Range.Text = code.Value Else wdapp.ActiveDocument.Bookmarks("code").Range.Text = "." End If ' je sauvegarde le fichier sous un autre nom wdapp.ActiveDocument.SaveAs "j:\Doc_Atelier\td138\" & moncode & ".doc" ' je ferme le fichier wdapp.ActiveDocument.Close ' je ferme l'application wdapp.Application.Quit SaveChanges:=wdDoNotSaveChanges ' et j'avertis l'utilisateur que le fichier word est crée MsgBox "Le fichier WORD est crée !" set wdapp=nothing End Sub
Quelques explications :

wdapp.ActiveDocument.Bookmarks("code").Range.Text = code.Value
Dans cet exemple, nous avons utilisé la propriété Text de l'objet Range pour mettre à jour les données voulues dans le signet. Si vous souhaitez ajouter ces données à des données déjà existantes dans le signet, vous pouvez vous intéresser aux méthodes InsertBefore et InsertAfter.



Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2004-2005 Maxence Hubiche Developpez LLC. Tous droits réservés Developpez LLC. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents et images sans l'autorisation expresse de Developpez LLC. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.