Créer une table ACCESS vide

laurent - responsable Technique 11 février 2015 Comments

Voilà un petit code fort pratique en ASP pour copier une table vide avec le nom de votre choix (nom_table). La table VIDE correspond à la table que vous souhaitez copier, bien entendu vous aurez pris soin de la créer avec les champs de votre choix sans données.

<%@ Language=VBScript %> 
<% 

' === création table M si inexistante =============================================

Set ConBDD     = CreateObject("ADODB.Connection")

sDB                  = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=d:\www\chemin_physique_vers_votre_base" 

conBDD.Open sDB
dim rs2:set rs2=createobject("ADODB.recordset")

nom_table = DatePart("m",Date()) &"_"& DatePart("yyyy",Date())
flag_er=True

rs2.open conBDD.OpenSchema (20)
do while not rs2.eof
            if rs2(3)= "TABLE" then
                        if rs2(2)= nom_table then
                        flag_er=False:   exit do
                        end if
            end if 
rs2.movenext
loop
rs2.close

if flag_er then    
            conBDD.execute "SELECT * INTO " & nom_table & " from VIDE;"           ' table vide avec les champs prédéfinis
            rs2.open "select * from STATS order by id_stat", conBDD,1,2
            rs2.addnew
            rs2("stat_table") = nom_table
            rs2.update
            rs2.close
end if

' fermeture connexion
set rs2=nothing: set rs=nothing
conBDD.Close


'---- Détermine si l'année est bisextiles ou pas ----
Function BisexYear(WhichYear)
    If WhichYear/4=Int(WhichYear/4) Then
        BisexYear=True
    Else
        BisexYear=False
    End If
End Function

'---- Le nombre de jours dans un mois ----
Function xDaysIn(WhichDate)
    Dim xdays
    xDays=Array("","31","","31","30","31","30","31","31","30","31","30","31")
    If Month(WhichDate)=2 Then
        If BisexYear(Year(WhichDate))=True Then
            xDaysIn=29
        Else
            xDaysIn=28
        End If      
    Else
        xDaysIn=xDays(Month(WhichDate))
    End If
End Function   

%>

<%@ Language=VBScript %>

' === création table M si inexistante =============================================

Set ConBDD = CreateObject("ADODB.Connection")

sDB = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=d:\www\chemin_physique_vers_votre_base"

conBDD.Open sDB

dim rs2:set rs2=createobject("ADODB.recordset")

nom_table = DatePart("m",Date()) &"_"& DatePart("yyyy",Date())

flag_er=True

rs2.open conBDD.OpenSchema (20)

do while not rs2.eof

if rs2(3)= "TABLE" then

if rs2(2)= nom_table then

flag_er=False: exit do

end if

rs2.movenext

loop

rs2.close

if flag_er then

conBDD.execute "SELECT * INTO " & nom_table & " from VIDE;" ' table vide avec les champs prédéfinis

rs2.open "select * from STATS order by id_stat", conBDD,1,2

rs2.addnew

rs2("stat_table") = nom_table

rs2.update

rs2.close

end if

' fermeture connexion

set rs2=nothing: set rs=nothing

conBDD.Close

'---- Détermine si l'année est bisextiles ou pas ----

Function BisexYear(WhichYear)

If WhichYear/4=Int(WhichYear/4) Then

BisexYear=True

Else

BisexYear=False

End If

End Function

'---- Le nombre de jours dans un mois ----

Function xDaysIn(WhichDate)

Dim xdays

xDays=Array("","31","","31","30","31","30","31","31","30","31","30","31")

If Month(WhichDate)=2 Then

If BisexYear(Year(WhichDate))=True Then

xDaysIn=29

Else

xDaysIn=28

End If

Else

xDaysIn=xDays(Month(WhichDate))

End If

End Function

PS : Vous noterez deux petites fonctions capables de déterminer si l’année est bissextile et le nombre de jours dans un mois.

Smartp Upload, exemple d’utilisation

laurent - responsable Technique 11 février 2015 Comments

Un petit exemple simple d’utilisation de smart upload :

Le formulaire :

<form method="post" action="tapagedetraitement.asp" ENCTYPE="multipart/form-data" id=form1 name=form1>
<table width="100%" border=0>
<tr><td align=center><input type="file" name="fichier" class=form></td></tr>
<tr><td>&nbsp;</td></tr>
<tr><td align=center><input type="submit" value="Enregistrer" class=envoi2 name=submit></td></tr>
</table>
</form>

</table>

</form>

La page de traitement :

cheminPDF = Server.MapPath("download/") &"\"

Set mySmartUpload = Server.CreateObject("aspSmartUpload.SmartUpload")
mySmartUpload.Upload
For each file In mySmartUpload.Files
   If not file.IsMissing Then
      nom_ext      = file.FileExt   ' extension
      nom_fichier   = file.FileName   ' nom complet
      if lcase(nom_ext)="pdf" then
         ' rec ---------------------------------------------------------
         file.SaveAs cheminPDF & nom_fichier
         mem="":  msg="<b><font color=green>> Votre fichier est correctement enregistré.</font></b>"
      else
         mem="erreur":   msg="<b><font color=red>> Votre fichier n'est pas un .pdf, il n'a pu être enregistré.</font></b>"
      end if
   Else
      mem="erreur":   msg="<b><font color=red>> Fichier manquant, vous avez oublié de sélectionner un PDF.</font></b>"
   End if
Next
Set mySmartUpload = Nothing
response.write(msg)

cheminPDF = Server.MapPath("download/") &"\"

Set mySmartUpload = Server.CreateObject("aspSmartUpload.SmartUpload")

mySmartUpload.Upload

For each file In mySmartUpload.Files

If not file.IsMissing Then

nom_ext = file.FileExt ' extension

nom_fichier = file.FileName ' nom complet

if lcase(nom_ext)="pdf" then

' rec ---------------------------------------------------------

file.SaveAs cheminPDF & nom_fichier

mem="": msg="<b><font color=green>> Votre fichier est correctement enregistré.</font></b>"

else

mem="erreur": msg="<b><font color=red>> Votre fichier n'est pas un .pdf, il n'a pu être enregistré.</font></b>"

end if

Else

mem="erreur": msg="<b><font color=red>> Fichier manquant, vous avez oublié de sélectionner un PDF.</font></b>"

End if

Set mySmartUpload = Nothing

response.write(msg)

en admettant bien entendu qu’on stocke les fichiers dans le dossier /download.

MSXML sous IIS7

laurent - responsable Technique 11 février 2015 Comments

Comment utiliser msxml 3 ou 6 en ASP :

<%                
url = "http://www.serveur-windows.com"
set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP.6.0") 
xmlhttp.open "GET", url, false 
xmlhttp.send "" 
Response.write xmlhttp.responseText 
set xmlhttp = nothing 
%>

url = "http://www.serveur-windows.com"

set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP.6.0")

xmlhttp.open "GET", url, false

xmlhttp.send ""

Response.write xmlhttp.responseText

set xmlhttp = nothing

Pour utiliser la 3.0 il faudra donc écrire :

set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP.3.0")

1	set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP.3.0")

URL rewriting via le web.config

laurent - responsable Technique 11 février 201511 février 2015 Comments

Trouvé sur aspfr.com par Vladam, et ça marche du tonnerre, tout est implémenté dans le web.config avec la dll URLRewriter.dll :http://www.aspfr.com/codes/IMPLEMENTER-TRES-FACILEMENT-URLREWRITER-REECRITURE-URL-NET-GENIAL_31527.aspx

1°) Ouvrez votre WEB.CONFIG et ajoutez les éléments suivants :
    - Dans la section <configuration> ajoutez le code ci-dessous 
         <configSections>
      <section name="RewriterConfig" type="URLRewriter.Config.RewriterConfigSerializerSectionHandler, URLRewriter" />
   </configSections>
    - Dans la section <system.web> ajoutez le code ci-dessous
        <httpModules>
      <add type="URLRewriter.ModuleRewriter, URLRewriter" name="ModuleRewriter" />
   </httpModules>
   <httpHandlers>
      <add verb="*" path="*.aspx" type="URLRewriter.RewriterFactoryHandler, URLRewriter" />
   </httpHandlers>
2°) Il ne vous reste plus qu'a définir les Urls que vous souhaitez pour le rewriting
    pour cela, c'est très simple :
    Dans la section <configuration> sous l'élément <configSections> que vous avez déjà ajouté dans l'étape 2, vous ajoutez le nouvelle section ci-dessous :
    <RewriterConfig>
      <Rules>
         <RewriterRule>
            <LookFor>~/cartes_virtuelles_amour\.aspx</LookFor>
            <SendTo>~/themes.aspx?rel=4&amp;title=AMOUR</SendTo>
         </RewriterRule>
      </Rules>
    </RewriterConfig>
    Et vous pouvez répéter l'éléments <RewriterRule> autant de fois que vous avez de page à réécrire.

1°) Ouvrez votre WEB.CONFIG et ajoutez les éléments suivants :

- Dans la section <configuration> ajoutez le code ci-dessous

</configSections>

- Dans la section <system.web> ajoutez le code ci-dessous

</httpModules>

</httpHandlers>

2°) Il ne vous reste plus qu'a définir les Urls que vous souhaitez pour le rewriting

pour cela, c'est très simple :

Dans la section <configuration> sous l'élément <configSections> que vous avez déjà ajouté dans l'étape 2, vous ajoutez le nouvelle section ci-dessous :

<Rules>

<LookFor>~/cartes_virtuelles_amour\.aspx</LookFor>

<SendTo>~/themes.aspx?rel=4&title=AMOUR</SendTo>

</RewriterRule>

</Rules>

</RewriterConfig>

Et vous pouvez répéter l'éléments <RewriterRule> autant de fois que vous avez de page à réécrire.

Un tableau sans champ vide après un split

laurent - responsable Technique 11 février 201513 avril 2016 Comments

Une astuce toute simple qui permet de spliter un tableau sans plus se soucier d’un champ vide.

tabTemp = tabIp.Split(new string[] { "," }, StringSplitOptions.RemoveEmptyEntries);

1	tabTemp = tabIp.Split(new string[] { "," }, StringSplitOptions.RemoveEmptyEntries);

Erreur 404

laurent - responsable Technique 11 février 2015 Comments

IIS gère les erreurs 404 pour les pages asp,htm et php mais pas pour les pages en aspx qui sont gérées par le web.config, donc il faudra rajouter dans le web.config :

<configuration>
    <system.web>
        <customErrors mode="On" >
            <error statusCode="404" redirect="404.aspx" />
        </customErrors>

<system.web>

</customErrors>

en admettant que votre page d’erreur est 404.aspx bien entendu

Un tableau triable avec SortedList

laurent - responsable Technique 7 novembre 20147 novembre 2014 Comments

Un ch’tit code qui vous fera gagner beaucoup de temps si vous devez lancer une recherche dans un tableau, on va le ranger dans un sortedlist :

// ici mes champs avec mes valeurs
string  requete = "ALLOWNOTE=0" +
                "&amp;LOCALECODE=FR" +
                "&amp;PAYMENTREQUEST_0_PAYMENTACTION=Sale" +
                "&amp;PAYMENTREQUEST_0_CURRENCYCODE=EUR" +
                "&amp;PAYMENTREQUEST_0_AMT=12.00" +
                "&amp;PAYMENTREQUEST_0_ITEMAMT=10.00" +
                "&amp;PAYMENTREQUEST_0_TAXAMT=2.00";

// ici je crée mon tableau
string[] rowdata = requete.Split("&amp;".ToCharArray(), StringSplitOptions.RemoveEmptyEntries);
SortedList&lt;string, string&gt; varRecord = new SortedList&lt;string, string&gt;();
foreach (string var in rowdata)
{
string[] splitdata = var.Split('=');
varRecord.Add(splitdata[0], splitdata[1]);
}

// ici on lance la recherche
string search = "LOCALECODE";
try
{
Response.Write("Recherche pour " + search +" : " + varRecord[search ]);
}
catch
{
Response.Write("Rien trouvé pour " + search);
}

// ici mes champs avec mes valeurs

string requete = "ALLOWNOTE=0" +

"&LOCALECODE=FR" +

"&PAYMENTREQUEST_0_PAYMENTACTION=Sale" +

"&PAYMENTREQUEST_0_CURRENCYCODE=EUR" +

"&PAYMENTREQUEST_0_AMT=12.00" +

"&PAYMENTREQUEST_0_ITEMAMT=10.00" +

"&PAYMENTREQUEST_0_TAXAMT=2.00";

// ici je crée mon tableau

string[] rowdata = requete.Split("&".ToCharArray(), StringSplitOptions.RemoveEmptyEntries);

SortedList<string, string> varRecord = new SortedList<string, string>();

foreach (string var in rowdata)

{

string[] splitdata = var.Split('=');

varRecord.Add(splitdata[0], splitdata[1]);

}

// ici on lance la recherche

string search = "LOCALECODE";

try

{

Response.Write("Recherche pour " + search +" : " + varRecord[search ]);

}

catch

{

Response.Write("Rien trouvé pour " + search);

}

Réponse :

Recherche pour LOCALECODE = FR

1	Recherche pour LOCALECODE = FR

Tout sur le CDO

laurent - responsable Technique 4 novembre 20147 novembre 2014 Comments

Un grand merci au concepteur de http://www.sepa-convertir.eu qui nous livre ses recherches sur l’objet CDO.

<%
'Format HTML
Texte = "TOTO TITI TATA"
'Format non html
Msg = "TOTO TITI TATA" & vbcrlf

'=============================
'For the priority
'============================
Const cdoPriorityNonUrgent= -1      ' Nonurgent priority
Const cdoPriorityNormal= 0          ' Normal priority
Const cdoPriorityUrgent= 1          'Urgent priority
'===============================
'For the importance of the mail
'===============================
Const cdoLow= 0                    ' Low importance
Const cdoNormal= 1                 ' Normal importance
Const cdoHigh= 2                   ' High importance
'====================================
'For the sensitivity of the mail
'=================================
Const cdoSensitivityNone= 0         ' None
Const cdoPersonal = 1               ' Personal
Const cdoPrivate = 2                ' Private
Const cdoCompanyConfidential = 3    ' Company Confidential
Const CdoReferenceTypeName = 1
'================================================
' Beginning of paramters
'================================================
ToAddress = "toto@toto.fr"          ' destinataire de l'email ---Obligatoire
Subject = "SEPA-CONVERTIR.EU : Renseignements" ' Objet de l' email
'=============================
SmtpServer = "smtp.toto.fr"     'adresse du serveur smtp -- Obligatoire
Password = "titi"               'Mot de passe de votre compte email

FromName= " Jean DURAND"        ' Nom de la personne qui envoie l'email
FromAdress =  "toto@toto.fr"    ' addresse de l'expéditeur
'=======================
CcAddress = ""       ' addresse pour carbon copy - laisser à blanc si pas necessaire
BccAddress = ""     ' addresse pour block carbon copy - laisser à blanc si pas necessaire
Username = "toto@toto.fr"           ' adresse du compte mail depuis lequel le courriel est envoyé Obligatoire

' port utilise pour envoyer le mail  ex 25 pour un provider normal ou 465 pour gmail
IPPort = 25
' si ssl
IPPort = 465

ssl = 0     '0 si vous n'utilisez pas ssl ou 1 si vous utilisez ssl ex pour gmail
AttachFiles= ""     'liste des fichiers attaches que vous souhaitez envoyer (chemin physique de chaque fichier + nom + separe par des ;"
replyto = FromAdress 'adresse email souhaitée pour la réponse au mail
dispositionnotificationTo = FromAdress 'adresse souhaitée pour l'accusé de réception
ReturnreceiptTo=FromAdress  ' email si vous souhaitez avoir l'accusé de réception
Importance = cdoHigh        'Haute importance; Priotité d'envoi du message : "High=2", "Normal"=1, "Low=0"
Priorite =  cdoPriorityUrgent         'Priorité urgente
sensitivity = cdoCompanyConfidential   ' degré de confidentialité
transfert = 0                       ' 0 Ne pas transférer 1 Transfert libre

'=======================================================
' End of paramters
'======================================================

Set objemail = CreateObject("CDO.Message")

If IsObject(objemail) then
    objeMail.BodyPart.charset = "utf-8"
    Set iConf = CreateObject("CDO.Configuration")
    objemail.Configuration= iconf
    objemail.MimeFormatted= True
    objemail.to= ToAddress
    objEmail.From = Chr(34) &FromName & Chr(34)&"<" & FromAdress& ">"
    objemail.Subject= Subject
    'Pour le texte en HTML
    objemail.HTMLBody= Texte
    'Si le mailer n'est pas HTML
    objemail.TextBody = Msg
    objemail.replyTo= replyto
    If CcAddress <> ""  Then
        objemail.Cc = CcAddress
    End If
    If BccAddress <> "" then
        objemail.Bcc = BccAddress
    End If
    objemail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing")= 2
    objemail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver")= SmtpServer
    If IPPort = 0 then
        IPPort = 25
    End If
    objemail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")= IPPort
    'Authenticated SMTP
    If Username <> "" then
        objemail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate")= 1
        objemail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername")= Username
        objemail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword")= Password
    End If
    If ssl then
        objemail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl")= 2
    End If
    'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)
    objemail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout")= 60
    objeMail.Configuration.Fields.Update
    '==================
    ' sensitivity
    '================
    Select case sensitivity
    Case  cdoCompanyConfidential
        objemail.Fields.Item("urn:schemas:mailheader:Sensitivity") = "Company-Confidential"
    Case cdoPersonal
       objemail.Fields.Item("urn:schemas:mailheader:Sensitivity") = "Private"
    Case  cdoPrivate
       objemail.Fields.Item("urn:schemas:mailheader:Sensitivity") = "Personal"
    Case cdoSensitivityNone
       objemail.Fields.Item("urn:schemas:mailheader:Sensitivity") = "None"
    End Select

    Select case transfert
    Case 0
        objemail.Fields.Item("urn:schemas:mailheader:X-Message-Flag") = "Ne pas Transferer"
    Case 1
        oobjemail.Fields.Item("urn:schemas:mailheader:X-Message-Flag") = "Transfert Libre"
    End Select
    objemail.Configuration.Fields.Update
    
    Select case  Priorite
    Case     cdoPriorityUrgent
        objemail.Fields("urn:schemas:mailheader:X-MSMail-Priority") = "High"
        objemail.Fields("urn:schemas:mailheader:X-Priority") = CStr(cdoPriorityUrgent)
        objemail.Fields("Fields('urn:schemas:mailheader:priority") = CStr(cdoPriorityUrgent)
    Case     cdoPriorityNormal
        objemail.Fields("urn:schemas:mailheader:X-MSMail-Priority") = "Normal"
        objemail.Fields("urn:schemas:mailheader:X-Priority") = CStr(cdoPriorityNormal)
        objemail.Fields("Fields('urn:schemas:mailheader:priority") =  CStr(cdoPriorityNormal)
    Case     cdoPriorityNonUrgent
        objemail.Fields("urn:schemas:mailheader:X-MSMail-Priority") = "Low"
        objemail.Fields("urn:schemas:mailheader:X-Priority") = CStr(cdoPriorityNonUrgent)
        objemail.Fields("urn:schemas:mailheader:priority") = CStr(cdoPriorityNonUrgent)
    End Select

    Select case Importance
    Case cdoHigh
       objemail.Fields.Item("urn:schemas:httpmail:importance") = cdoHigh
    Case cdoNormal
       objemail.Fields.Item("urn:schemas:httpmail:importance") = cdoNormal
    Case cdoLow
       objemail.Fields.Item("urn:schemas:httpmail:importance") = cdoLow
    End Select

    If dispositionnotificationTo <> "" then
        objemail.Fields("urn:schemas:mailheader:disposition-notification-to")= dispositionnotificationTo
    end if
    If ReturnreceiptTo <> "" then
        objemail.Fields("urn:schemas:mailheader:return-receipt-to")= ReturnreceiptTo
    end if
    If dispositionnotificationTo <> ""  or ReturnreceiptTo <> "" then
    'Update settings
        objemail.Fields.Update
    end if

    'Déclaration des  "inline attachments" Permet d'inclure des images dans le corps du mail
    Path = Server.MapPath("/image/")
    Set objbodypart = objemail.AddRelatedBodyPart( Path& "\fond.gif" ,"fond.gif",CdoReferenceTypeName)
    objbodypart.Fields("urn:schemas:mailheader:Content-ID") = "<fond.gif>"
    objbodypart.Fields.Item("urn:schemas:mailheader:Content-Disposition") = "inline"
    objbodypart.Fields.Update
    Set objbodypart1 = objemail.AddRelatedBodyPart(Server.MapPath("/image/logo.gif") ,"logo.gif",CdoReferenceTypeName)
    objbodypart1.Fields("urn:schemas:mailheader:Content-ID") = "<logo.gif>"
    objbodypart1.Fields.Item("urn:schemas:mailheader:Content-Disposition") = "inline"
    objbodypart1.Fields.Update
    Set objbodypart2 = objemail.AddRelatedBodyPart(Server.MapPath("/image/toto.vcf") ,"sepa.vcf",CdoReferenceTypeName)
    objbodypart2.Fields("urn:schemas:mailheader:Content-ID") = "<toto.vcf>"
    objbodypart2.Fields.Item("urn:schemas:mailheader:Content-Disposition") = "inline"
    objbodypart2.Fields.Update

    ' Sending attach files
    If AttachFiles <> "" then
        Resultat= Split(AttachFiles, ";")
        for each x in resultat
            objemail.AddAttachment (x)
        Next
    End If
    'objEmail.DSNOptions = 14
    objemail.Send
    Set iconf=nothing
    Set objbodypart= Nothing
    set objbodypart1=Nothing
    set objbodypart2=Nothing
    set objemail= Nothing
Else
    Response.write "Sorry - Erreur de creation de l'objet"
End if
%>

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

'Format HTML

Texte = "TOTO TITI TATA"

'Format non html

Msg = "TOTO TITI TATA" & vbcrlf

'=============================

'For the priority

'============================

Const cdoPriorityNonUrgent= -1 ' Nonurgent priority

Const cdoPriorityNormal= 0 ' Normal priority

Const cdoPriorityUrgent= 1 'Urgent priority

'===============================

'For the importance of the mail

'===============================

Const cdoLow= 0 ' Low importance

Const cdoNormal= 1 ' Normal importance

Const cdoHigh= 2 ' High importance

'====================================

'For the sensitivity of the mail

'=================================

Const cdoSensitivityNone= 0 ' None

Const cdoPersonal = 1 ' Personal

Const cdoPrivate = 2 ' Private

Const cdoCompanyConfidential = 3 ' Company Confidential

Const CdoReferenceTypeName = 1

'================================================

' Beginning of paramters

'================================================

ToAddress = "toto@toto.fr" ' destinataire de l'email ---Obligatoire

Subject = "SEPA-CONVERTIR.EU : Renseignements" ' Objet de l' email

'=============================

SmtpServer = "smtp.toto.fr" 'adresse du serveur smtp -- Obligatoire

Password = "titi" 'Mot de passe de votre compte email

FromName= " Jean DURAND" ' Nom de la personne qui envoie l'email

FromAdress = "toto@toto.fr" ' addresse de l'expéditeur

'=======================

CcAddress = "" ' addresse pour carbon copy - laisser à blanc si pas necessaire

BccAddress = "" ' addresse pour block carbon copy - laisser à blanc si pas necessaire

Username = "toto@toto.fr" ' adresse du compte mail depuis lequel le courriel est envoyé Obligatoire

' port utilise pour envoyer le mail ex 25 pour un provider normal ou 465 pour gmail

IPPort = 25

' si ssl

IPPort = 465

ssl = 0 '0 si vous n'utilisez pas ssl ou 1 si vous utilisez ssl ex pour gmail

AttachFiles= "" 'liste des fichiers attaches que vous souhaitez envoyer (chemin physique de chaque fichier + nom + separe par des ;"

replyto = FromAdress 'adresse email souhaitée pour la réponse au mail

dispositionnotificationTo = FromAdress 'adresse souhaitée pour l'accusé de réception

ReturnreceiptTo=FromAdress ' email si vous souhaitez avoir l'accusé de réception

Importance = cdoHigh 'Haute importance; Priotité d'envoi du message : "High=2", "Normal"=1, "Low=0"

Priorite = cdoPriorityUrgent 'Priorité urgente

sensitivity = cdoCompanyConfidential ' degré de confidentialité

transfert = 0 ' 0 Ne pas transférer 1 Transfert libre

'=======================================================

' End of paramters

'======================================================

Set objemail = CreateObject("CDO.Message")

If IsObject(objemail) then

objeMail.BodyPart.charset = "utf-8"

Set iConf = CreateObject("CDO.Configuration")

objemail.Configuration= iconf

objemail.MimeFormatted= True

objemail.to= ToAddress

objEmail.From = Chr(34) &FromName & Chr(34)&"<" & FromAdress& ">"

objemail.Subject= Subject

'Pour le texte en HTML

objemail.HTMLBody= Texte

'Si le mailer n'est pas HTML

objemail.TextBody = Msg

objemail.replyTo= replyto

If CcAddress <> "" Then

objemail.Cc = CcAddress

End If

If BccAddress <> "" then

objemail.Bcc = BccAddress

End If

objemail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing")= 2

objemail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver")= SmtpServer

If IPPort = 0 then

IPPort = 25

End If

objemail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport")= IPPort

'Authenticated SMTP

If Username <> "" then

objemail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate")= 1

objemail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername")= Username

objemail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword")= Password

End If

If ssl then

objemail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl")= 2

End If

'Connection Timeout in seconds (the maximum time CDO will try to establish a connection to the SMTP server)

objemail.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout")= 60

objeMail.Configuration.Fields.Update

'==================

' sensitivity

'================

Select case sensitivity

Case cdoCompanyConfidential

objemail.Fields.Item("urn:schemas:mailheader:Sensitivity") = "Company-Confidential"

Case cdoPersonal

objemail.Fields.Item("urn:schemas:mailheader:Sensitivity") = "Private"

Case cdoPrivate

objemail.Fields.Item("urn:schemas:mailheader:Sensitivity") = "Personal"

Case cdoSensitivityNone

objemail.Fields.Item("urn:schemas:mailheader:Sensitivity") = "None"

End Select

Select case transfert

Case 0

objemail.Fields.Item("urn:schemas:mailheader:X-Message-Flag") = "Ne pas Transferer"

Case 1

oobjemail.Fields.Item("urn:schemas:mailheader:X-Message-Flag") = "Transfert Libre"

End Select

objemail.Configuration.Fields.Update

Select case Priorite

Case cdoPriorityUrgent

objemail.Fields("urn:schemas:mailheader:X-MSMail-Priority") = "High"

objemail.Fields("urn:schemas:mailheader:X-Priority") = CStr(cdoPriorityUrgent)

objemail.Fields("Fields('urn:schemas:mailheader:priority") = CStr(cdoPriorityUrgent)

Case cdoPriorityNormal

objemail.Fields("urn:schemas:mailheader:X-MSMail-Priority") = "Normal"

objemail.Fields("urn:schemas:mailheader:X-Priority") = CStr(cdoPriorityNormal)

objemail.Fields("Fields('urn:schemas:mailheader:priority") = CStr(cdoPriorityNormal)

Case cdoPriorityNonUrgent

objemail.Fields("urn:schemas:mailheader:X-MSMail-Priority") = "Low"

objemail.Fields("urn:schemas:mailheader:X-Priority") = CStr(cdoPriorityNonUrgent)

objemail.Fields("urn:schemas:mailheader:priority") = CStr(cdoPriorityNonUrgent)

End Select

Select case Importance

Case cdoHigh

objemail.Fields.Item("urn:schemas:httpmail:importance") = cdoHigh

Case cdoNormal

objemail.Fields.Item("urn:schemas:httpmail:importance") = cdoNormal

Case cdoLow

objemail.Fields.Item("urn:schemas:httpmail:importance") = cdoLow

End Select

If dispositionnotificationTo <> "" then

objemail.Fields("urn:schemas:mailheader:disposition-notification-to")= dispositionnotificationTo

end if

If ReturnreceiptTo <> "" then

objemail.Fields("urn:schemas:mailheader:return-receipt-to")= ReturnreceiptTo

end if

If dispositionnotificationTo <> "" or ReturnreceiptTo <> "" then

'Update settings

objemail.Fields.Update

end if

'Déclaration des "inline attachments" Permet d'inclure des images dans le corps du mail

Path = Server.MapPath("/image/")

Set objbodypart = objemail.AddRelatedBodyPart( Path& "\fond.gif" ,"fond.gif",CdoReferenceTypeName)

objbodypart.Fields("urn:schemas:mailheader:Content-ID") = "<fond.gif>"

objbodypart.Fields.Item("urn:schemas:mailheader:Content-Disposition") = "inline"

objbodypart.Fields.Update

Set objbodypart1 = objemail.AddRelatedBodyPart(Server.MapPath("/image/logo.gif") ,"logo.gif",CdoReferenceTypeName)

objbodypart1.Fields("urn:schemas:mailheader:Content-ID") = "<logo.gif>"

objbodypart1.Fields.Item("urn:schemas:mailheader:Content-Disposition") = "inline"

objbodypart1.Fields.Update

Set objbodypart2 = objemail.AddRelatedBodyPart(Server.MapPath("/image/toto.vcf") ,"sepa.vcf",CdoReferenceTypeName)

objbodypart2.Fields("urn:schemas:mailheader:Content-ID") = "<toto.vcf>"

objbodypart2.Fields.Item("urn:schemas:mailheader:Content-Disposition") = "inline"

objbodypart2.Fields.Update

' Sending attach files

If AttachFiles <> "" then

Resultat= Split(AttachFiles, ";")

for each x in resultat

objemail.AddAttachment (x)

End If

'objEmail.DSNOptions = 14

objemail.Send

Set iconf=nothing

Set objbodypart= Nothing

set objbodypart1=Nothing

set objbodypart2=Nothing

set objemail= Nothing

Else

Response.write "Sorry - Erreur de creation de l'objet"

End if

ASP ADO Access 64 bits

laurent - responsable Technique 6 octobre 201425 mars 2016 Comments

Comment faire tourner Access ou Excel en ADO sous un pool 64 bits ?

Récupérer AccessDatabaseEngine_x64.exe sur :
http://www.microsoft.com/fr-FR/download/details.aspx?id=13255

Exécuter :

cmd.exe c:\locationofdownloadedfile\AccessDatabaseEngine_x64.exe /passive

1	cmd.exe c:\locationofdownloadedfile\AccessDatabaseEngine_x64.exe /passive

Attention, lancer la commande en mode passif a toute son son importance, ça permet de rajouter cet ADO sans perturber une installation déjà existante (32 ou 64 bits).

Ensuite pour la connexion :

Set Con = Server.CreateObject("ADODB.Connection")
Con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\pathtoaccessdatabase\accessdatabase.mdb;Persist Security Info=False;"

1 2	Set Con = Server.CreateObject("ADODB.Connection") Con.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\pathtoaccessdatabase\accessdatabase.mdb;Persist Security Info=False;"

Initialisation des Lecteurs réseau

laurent - responsable Technique 14 mai 2014 Comments

Pour info, si un jour vous avez besoin d’initialiser des lecteurs réseau, pour ce j’utilise pour un petit fichier .bat que j’insère dans le démarrage de windows :

net use * /DELETE /YES 
net use "x:" "\\diskstation\public" "password" /USER:admin /PERSISTENT:YES /Y
net use "w:" "\\diskstation\web" "password" /USER:admin /PERSISTENT:YES /Y
etc..

net use * /DELETE /YES

net use "x:" "\\diskstation\public" "password" /USER:admin /PERSISTENT:YES /Y

net use "w:" "\\diskstation\web" "password" /USER:admin /PERSISTENT:YES /Y

etc..

password étant bien sûr à personnaliser, c’est le mdp d’un compte admin.
la 1ère ligne supprime toutes les connexions réseaux existantes et les deux lignes suivantes les (re)créent.

Actualités, interventions et astuces en hébergement

Astuces

Créer une table ACCESS vide

Smartp Upload, exemple d’utilisation

MSXML sous IIS7

URL rewriting via le web.config

Un tableau sans champ vide après un split

Erreur 404

Un tableau triable avec SortedList

Tout sur le CDO

ASP ADO Access 64 bits

Initialisation des Lecteurs réseau