traitement d'un fichier d'une liste d'un formulaire:
- Code: Tout sélectionner
Private Sub L_Fichier_DblClick(Cancel As Integer)
Dim nomb As String
Dim ctl As String
Dim cmd As String
Dim leChemin As String
Dim MyName As String
' Dim MyPath As String
' Dim Ligne As Integer
' Dim Ligne2 As Integer
DoCmd.SetWarnings False
DoCmd.RunSQL "Drop Table Import"
DoCmd.RunSQL "Drop Table Theme"
leChemin = "e:BaseImport"
ctl = leChemin & Me.L_Fichier.Value
DoCmd.TransferSpreadsheet acImport, 8, "Import", ctl, True, "Import"
DoCmd.TransferSpreadsheet acImport, 8, "Theme", ctl, True, "Theme"
cmd = "DELETE * FROM Import " _
& "WHERE (((Import.[N°]) Is Null) " _
& "AND ((Import.Complt) Is Null) " _
& "AND ((Import.Civilité) Is Null) " _
& "AND ((Import.[Nom Prénom]) Is Null) " _
& "AND ((Import.Tel) Is Null) AND ((Import.Date) Is Null) " _
& "AND ((Import.Contact) Is Null) " _
& "AND ((Import.Observations) Is Null) AND ((Import.Clé) Is Null) AND ((Import.Parité) is Null));"
DoCmd.SetWarnings False
DoCmd.RunSQL cmd
MyName = Me.L_Fichier.Value
If Right(MyName, 7) <> "air.xls" And Right(MyName, 4) = ".xls" And Left(MyName, 7) = "Export_" Then
cmd = "Update Import " _
& "SET Import.clé = ( Mid('" & MyName & "', 8, Len('" & MyName & "') - 11));"
End If
If Right(MyName, 10) = "Impair.xls" And Right(MyName, 4) = ".xls" And Left(MyName, 7) = "Export_" Then
cmd = "Update Import " _
& "SET Import.clé = ( Mid('" & MyName & "', 8, Len('" & MyName & "') - 17));"
Else
If Right(MyName, 8) = "pair.xls" And Right(MyName, 4) = ".xls" And Left(MyName, 7) = "Export_" Then
cmd = "Update Import " _
& "SET Import.clé = ( Mid('" & MyName & "', 8, Len('" & MyName & "') - 15));"
End If
End If
DoCmd.RunSQL cmd
DoCmd.OpenForm "Menu_Visu"
DoCmd.SetWarnings True
End Sub
News
Plan de site
SitemapIndex
Flux RSS
