Set fd = Application.FileDialog(3)
fd.Title = "Select A File"
fd.AllowMultiSelect = True
fd.Filters.Clear
fd.Filters.Add "CSV File", "*.CSV"
If fd.Show = True Then
For Each varFile In fd.SelectedItems
GetFileName = varFile
If fd.SelectedItems.Count > 0 Then
MsgBox "File choosen = " & fd.SelectedItems.Count
Else
MsgBox "No file was selected"
Exit Sub
End If
Next
End If
Whenever I run this in VBA, a prompt open to select a file and if I select any number of files, the program runs properly . While if I click 'cancel' instead of selecting files, the program does not exit the sub and just exists the what may be the error ? Thanks
In VBA -1 evaluates to True. So your best bet is to do something like this:
Set fd = Application.FileDialog(3)
fd.Title = "Select A File"
fd.AllowMultiSelect = True
fd.Filters.Clear
fd.Filters.Add "CSV File", "*.CSV"
Dim FileChosen As Integer
FileChosen = fd.Show
If FileChosen <> -1 Then
MsgBox "No file was selected"
Exit Sub
Else
For Each varFile In fd.SelectedItems
MsgBox "File choosen = " & varFile
End For
End If
Related
My intent is to deny users that do not meet a certain access level access to forms. I initially had issues with error code 3265 while writing the code for:
TempVars("EmployeeType").Value = rs!EmployeeType_ID.Value
This is no longer an issue; however, I cannot get access to the form even when the appropriate user is trying to enter. I've checked the spelling of table and column names multiple times as well.
Below is my code for the login (where I'm using the tempvars), followed by the code in form Load().
Option Compare Database
Option Explicit
Private Sub btnLogin_Click()
Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset("Employees", dbOpenSnapshot, dbReadOnly)
rs.FindFirst "UserName='" & Me.txtUserName & "'"
If rs.NoMatch = True Then
Me.lblWrongUser.Visible = True
Me.txtUserName.SetFocus
Exit Sub
End If
Me.lblWrongUser.Visible = False
If rs!Password <> Me.txtPassword Then
Me.lblWrongPass.Visible = True
Me.txtPassword.SetFocus
Exit Sub
End If
If IsNull(Me.txtUserName) Or IsNull(Me.txtPassword) Then
MsgBox "You must enter password or login ID.", vbOKOnly + vbInformation, "Required Data"
Me.txtUserName.SetFocus
Exit Sub
End If
Me.lblWrongPass.Visible = False
If rs!EmployeeType >= 4 Then
Dim prop As Property
On Error GoTo SetProperty
Set prop = CurrentDb.CreateProperty("AllowBypassKey", dbBoolean, False)
TempVars("UserName").Value = Me.txtUserName.Value
TempVars("EmployeeType").Value = rs!EmployeeType_ID.Value
CurrentDb.Properties.Append prop
SetProperty:
If MsgBox("Would you like to turn on the bypass key?", vbYesNo, "Allow Bypass") = vbYes Then
CurrentDb.Properties("AllowBypassKey") = True
Else
CurrentDb.Properties("AllowBypassKey") = False
End If
End If
Me.Visible = False
DoCmd.OpenForm "frmMain"
Globals.LoggingSignOn "Logon"
End Sub
Private Sub Form_Load()
Me.txtUserName = Null
Me.txtPassword = Null
Me.txtUserName.SetFocus
End Sub
Private Sub Form_Unload(Cancel As Integer)
Globals.LoggingSignOn "Logoff"
End Sub
Private Sub Form_Load()
If Nz(DLookup("HasAccess", "tbl9EmployeeAccess", "EmployeeType_ID=" & TempVars("EmployeeType") & " FormName='" & Me.Name & "'"), False) = False Then
MsgBox "You do not have access to access this location."
DoCmd.Close acForm, Me.Name
End If
End Sub
Thank you for your time, to anybody that looks into this.
In my form access I want to make a button to browse / choose an excel file and import it in format a table in access.
This is my code.
' Requires reference to Microsoft Office 15.0 Object Library. '
Public Function ImportDocument() As TaskImportEnum
On Error GoTo ErrProc
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.InitialFileName = "Some folder"
.Title = "Dialog Title"
With .Filters
.Clear
.Add "xlsx documents", "*.xlsx", 1
End With
.ButtonName = " Import Selected "
.AllowMultiSelect = False 'Change this to TRUE to enable multi-select
'If aborted, the Function will return the default value of Aborted
If .Show = 0 Then GoTo Leave
End With
Dim selectedItem As Variant
For Each selectedItem In fd.SelectedItems
DoCmd.TransferText acImportDelim, "Raw Data from Import_ Import Specification", "Raw Data from Import", selectedItem, True, ""
Next selectedItem
ImportDocument = TaskImportEnum.Success
Leave:
Set fd = Nothing
On Error GoTo 0
Exit Function
ErrProc:
MsgBox err.Description, vbCritical
ImportDocument = TaskImportEnum.Failure 'Return Failure if error
Resume Leave
End Function
The code in question is part of a solution provided here. However, a few changes are required as the solution provided relates to a CSV file import.
In a Standard Module, paste the following:
Public Enum TaskImportEnum
Aborted = 0 'default
Success
Failure
End Enum
Public Function ImportDocument() As TaskImportEnum
On Error GoTo ErrProc
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.InitialFileName = "Some folder"
.Title = "Dialog Title"
With .Filters
.Clear
.Add "Excel documents", "*.xlsx", 1
End With
.ButtonName = " Import Selected "
.AllowMultiSelect = False 'Change this to TRUE to enable multi-select
'If aborted, the Function will return the default value of Aborted
If .Show = 0 Then GoTo Leave
End With
Dim selectedItem As Variant
For Each selectedItem In fd.SelectedItems
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "YourTableName", selectedItem, True, "YourSheetName$" 'Change 'YourTableName' and 'YourSheetName' to the actual names
Next selectedItem
'Return Success
ImportDocument = TaskImportEnum.Success
Leave:
Set fd = Nothing
On Error GoTo 0
Exit Function
ErrProc:
MsgBox Err.Description, vbCritical
ImportDocument = TaskImportEnum.Failure 'Return Failure if error
Resume Leave
End Function
On your button's Click event paste the following:
Dim status_ As TaskImportEnum
status_ = ImportDocument
Select Case status_
Case TaskImportEnum.Success:
MsgBox "Success!"
Case TaskImportEnum.Failure:
MsgBox "Failure..."
Case Else:
MsgBox "Aborted..."
End Select
In my database, I can made a command button import a file using the following:
DoCmd.TransferText acImportDelim, "Raw Data from Import_ Import Specification", "Raw Data from Import", D:\Users\Denise_Griffith\Documents\Griffith\PRIME RECON FILES\jdaqawmslesfilesemailDLX_SHPREC_2017-04-26_03-33-47.csv, True, ""
But I would like to have the user choose the file to import, since the filename is different every day based on date and time it was created. I have found this site (http://access.mvps.org/access/api/api0001.htm) and was able to get the dialog to pop up to allow the user to navigate and select the file, but I do not know how to incorporate it so the file selected is imported using the specification I created, and into the appropriate table.
Please help!
You need to set a reference to Microsoft Office Object Library.
Public Sub ImportDocument()
On Error GoTo ErrProc
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.InitialFileName = "Some folder"
.Title = "Some Title"
With .Filters
.Clear
.Add "CSV documents", "*.csv", 1
End With
.ButtonName = " Import Selected "
.AllowMultiSelect = False
If .Show = 0 Then GoTo Leave
End With
Dim selectedItem As Variant
For Each selectedItem In fd.SelectedItems
DoCmd.TransferText acImportDelim, "Raw Data from Import_ Import Specification", "Raw Data from Import", selectedItem, True, ""
Next
Leave:
Set fd = Nothing
On Error GoTo 0
Exit Sub
ErrProc:
MsgBox Err.Description, vbCritical
Resume Leave
End Sub
Update after user's comments:
You must change the Sub to a Function and check the return value.
The simplest way is to return a Boolean, where FALSE indicates aborted and TRUE indicates success. However by doing so, you exclude the Error scenario as both Aborted and Error will return FALSE.
Therefore you can return a Long value e.g. 0, 1, 2 indicating Aborted, Success and Error respectively. In order to avoid the "magic numbers" though, I would create and return an Enum type as shown below:
Public Enum TaskImportEnum
Aborted = 0 'default
Success
Failure
End Enum
Public Function ImportDocument() As TaskImportEnum
On Error GoTo ErrProc
Dim fd As FileDialog
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
.InitialFileName = "Some folder"
.Title = "Dialog Title"
With .Filters
.Clear
.Add "CSV documents", "*.csv", 1
End With
.ButtonName = " Import Selected "
.AllowMultiSelect = False 'Change this to TRUE to enable multi-select
'If aborted, the Function will return the default value of Aborted
If .Show = 0 Then GoTo Leave
End With
Dim selectedItem As Variant
For Each selectedItem In fd.SelectedItems
DoCmd.TransferText acImportDelim, "Raw Data from Import_ Import Specification", "Raw Data from Import", selectedItem, True, ""
Next selectedItem
'Return Success
ImportDocument = TaskImportEnum.Success
Leave:
Set fd = Nothing
On Error GoTo 0
Exit Function
ErrProc:
MsgBox Err.Description, vbCritical
ImportDocument = TaskImportEnum.Failure 'Return Failure if error
Resume Leave
End Function
Lastly, you can call the Function like this:
Sub Import()
Dim status_ As TaskImportEnum
status_ = ImportDocument
Select Case status_
Case TaskImportEnum.Success:
MsgBox "Success!"
Case TaskImportEnum.Failure:
MsgBox "Failure..."
Case Else:
MsgBox "Aborted..."
End Select
End Sub
You can read more about the Enum type here: http://www.cpearson.com/excel/Enums.aspx
This question is continued from here: Add user input to Excel table upon upload to Access database
Now that I have my fields connected to a table in my database, I want to make sure that everyone fills them in. Upon clicking the Import button, I want to check the fields (SANumber, SerialNumber, CustomerName, and LyoSize) to make sure it will be a 'valid upload'.
I have this code so far:
Function CheckInputs() As Boolean
If Me.SANumber.value Or Me.SerialNumber.value Or Me.CustomerName.value Or Me.LyoSize.value = Null Then
CheckInputs = True
Else
CheckInputs = False
End If
End Function
'Import MCL Files Code
Private Sub ImportMCL_Click()
On Error GoTo ErrorHandler
'disable ms access warnings
DoCmd.SetWarnings False
Call CheckInputs
If CheckInputs = True Then
MsgBox "All inputs must be entered!"
Exit Sub
Else
'load spreadsheet in .xls format
DoCmd.TransferSpreadsheet acImport, 8, "_MCL_UPLOAD", selectFile(), True
DoCmd.OpenQuery "UpdateMCL"
Call InsertInto_MASTER_UPLOAD
Call Delete_MCL_UPLOAD
MsgBox "MCL Imported Successfully!"
're-enable ms access warnings
DoCmd.SetWarnings True
End If
Exit Sub
ErrorHandler:
MsgBox "There was an Error: " & Err & ": " & Error(Err)
End Sub
It should work, but keeps on giving me the
ERROR: 13. Type Mismatch
You need to specifically check each field for null - you cannot do it this way:
If Me.SANumber.value Or Me.SerialNumber.value Or _
Me.CustomerName.value Or Me.LyoSize.value = Null Then
Something like
If IsNull(Me.SANumber) Or IsNull(SerialNumber) Or _
IsNull(Me.CustomerName) Or IsNull(Me.LyoSize) = Null Then
You should rename your function to something like "EmptyInputs" to make your code a little more self-documenting. "CheckInputs" is a little non-descriptive.
You CheckInputs() functions logic is incorrect. Or will return true if any one condition is meet. To get your desired result you can either ask does:
If Condition1 = true AND Condition2 = true AND ....
Otherwise you can ask If Condition1 = false OR Condition2 = false OR ....
Try this....
Function isFormValid() As Boolean
If isTextFieldInvalid(Me.SANumber) Or isTextFieldInvalid(Me.SerialNumber) Or isTextFieldInvalid(Me.CustomerName.Value) Or Me.LyoSize.Value = Null Then
isFormValid = False
Else
isFormValid = True
End If
End Function
Function isTextFieldInvalid(FieldControl) As Boolean
If Not IsNull(FieldControl) Then
If Len(Trim(FieldControl.Value)) Then
isFieldValid = True
End If
End If
End Function
'Import MCL Files Code
Private Sub ImportMCL_Click()
On Error GoTo ErrorHandler
'disable ms access warnings
DoCmd.SetWarnings False
If isFormValid Then
MsgBox "All inputs must be entered!"
Exit Sub
Else
'load spreadsheet in .xls format
DoCmd.TransferSpreadsheet acImport, 8, "_MCL_UPLOAD", selectFile(), True
DoCmd.OpenQuery "UpdateMCL"
Call InsertInto_MASTER_UPLOAD
Call Delete_MCL_UPLOAD
MsgBox "MCL Imported Successfully!"
're-enable ms access warnings
DoCmd.SetWarnings True
End If
Exit Sub
ErrorHandler:
MsgBox "There was an Error: " & Err & ": " & Error(Err)
End Sub
Also, if you're clearing out afterwards by going something like SANumber = "" then testing for Nulls might not work. I'd check for both nulls and blanks. This is a general template you could use.
Dim LResponse As Integer
If (Nz(Me.SANumber.Value) = "") Then
MsgBox "Please enter a SA Number.", vbCritical + vbOKOnly, "Error"
ElseIf (Nz(Me.SerialNumber.Value) = "") Then
MsgBox "Please enter a Serial Number.", vbCritical + vbOKOnly, "Error"
'All criteria met
Else
LResponse = MsgBox("Would you like to submit? ", vbQuestion + vbYesNo, "Question")
If LResponse = vbYes Then
'enter code here
ElseIf LResponse = vbNo Then
MsgBox ("Not submitted.")
End If
End If
Here is a sample code module. The methods I used in previous version of Access do not work because the AllModules collection no longer contains objects for Form and report modules. If you have a code module to back up, it must be done separately with the following module.
Public Sub ExportModules2013()
Dim boolCloseModule As Boolean
Dim frm As Form
Dim i As Integer
Dim iModuleType As Integer
Dim modModule As Module
Dim modOpenModules As Modules
Dim obj As AccessObject, dbs As Object
Dim rpt As Report
Dim sFileName As String
Dim sPath As String
'
sPath = "X:\Perryaire\Source\201308025\"
'
Set dbs = Application.CurrentProject
' Search for all AccessObject objects in AllForms Collection.
For Each obj In dbs.AllForms
DoCmd.OpenForm obj.Name, acDesign
Set frm = Forms(obj.Name)
If frm.HasModule Then
Set modModule = frm.Module
GoSub L_ExportModule
End If
DoCmd.Close acForm, frm.Name
Set frm = Nothing
Next obj
' Search for all AccessObject objects in AllReports Collection.
For Each obj In dbs.AllReports
DoCmd.OpenReport obj.Name, acDesign
Set rpt = Reports(obj.Name)
If rpt.HasModule Then
Set modModule = rpt.Module
GoSub L_ExportModule
End If
DoCmd.Close acReport, rpt.Name
Set rpt = Nothing
Next obj
' Search for all AccessObject objects in AllModules collection.
For Each obj In dbs.AllModules
If Not obj.IsLoaded Then
DoCmd.OpenModule (obj.Name)
End If
Set modModule = Application.Modules(obj.Name)
GoSub L_ExportModule
If boolCloseModule Then DoCmd.Close acModule, modModule.Name
Next obj
Exit Sub
L_ExportModule:
With modModule
iModuleType = acStandardModule
On Error Resume Next
iModuleType = .Type
sFileName = Nz(.Name, "MISSING:") & IIf(iModuleType = acStandardModule, ".bas", ".cls")
Lopen:
On Error GoTo Lmkdir
Open sPath & sFileName For Output As #1
If modModule.Type = acStandardModule Then
Print #1, "Attribute VB_Name = """ & .Name & """"
Else
Print #1, "VERSION 1.0 CLASS"
Print #1, "BEGIN"
Print #1, " MultiUse = -1 'True"
Print #1, "End"
Print #1, "Attribute VB_Name = """ & .Name & """"
Print #1, "Attribute VB_GlobalNameSpace = False"
Print #1, "Attribute VB_Creatable = False"
Print #1, "Attribute VB_PredeclaredId = False"
Print #1, "Attribute VB_Exposed = False"
End If
Print #1, .Lines(1, CLng(.CountOfLines))
Close #1
End With
Return
Lmkdir:
If Err.Number = "76" Then
MkDir sPath
Resume Lopen
Else
MsgBox "Error: " & Err.Number & " " & Err.Description
End If
Exit Sub
End Sub
You can try the following code. It will export all the module, class and form code and save to the current project folder. Remember to refer to / Check the Microsoft Visual Basic For Applications Extensibility Library in
VBE > Tools > References
Sub ExportAllCode()
For Each c In Application.VBE.VBProjects(1).VBComponents
Select Case c.Type
Case vbext_ct_ClassModule, vbext_ct_Document
Sfx = ".cls"
Case vbext_ct_MSForm
Sfx = ".frm"
Case vbext_ct_StdModule
Sfx = ".bas"
Case Else
Sfx = ""
End Select
If Sfx <> "" Then
c.Export _
fileName:=CurrentProject.Path & "\" & _
c.Name & Sfx
End If
Next c
End Sub
Have you tried to use the undocumented Application.SaveAsText functions?
Here is what I use to export all forms/reports/queries/modules:
Q6408951: Text-search in properties Access objects
Another related question:
Q187506: How do you use version control with Access development?
There is tool like this for Excel. Maybe you can look at the source and use the parts you want. http://www.codeproject.com/Articles/18029/SourceTools-xla