I have googled everywhere but I am unable to find out to do it without rewriting all the code, is there anyway to have this code check whether the file name matches table names and if it does then clear that table and re import or if not then create a new table?
Option Compare Database
Option Explicit
Private Sub btnBrowse_Click()
Dim diag As Office.FileDialog
Dim item As Variant
Set diag = Application.FileDialog(msoFileDialogFilePicker)
diag.AllowMultiSelect = False
diag.Title = "Please select an Excel Spreadsheet"
diag.Filters.Clear
diag.Filters.Add "Excel Spreadsheets", "*.xls, *.xlsx, *.xlsm"
If diag.Show Then
For Each item In diag.SelectedItems
Me.txtFileName = item
Next
End If
End Sub
Private Sub btnImportSpreadsheet_Click()
Dim FSO As New FileSystemObject
If FSO.FileExists(Nz(Me.txtFileName, "")) Then
ImportExcelSpreadsheet Me.txtFileName, FSO.GetFileName(Me.txtFileName)
ElseIf Nz(Me.txtFileName, "") = "" Then
MsgBox "Please select a file!", vbExclamation
Else
MsgBox "File not found!", vbExclamation
End If
End Sub
Public Sub ImportExcelSpreadsheet(Filename As String, TableName As String)
On Error Resume Next
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, TableName, Filename, True
If Err.Number = 3125 Then
If vbOK = MsgBox(Err.Description & vbNewLine & vbNewLine & "Skip column header and continue?", vbExclamation + vbOKCancel, "Error with Excel Column header") Then
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, TableName, Filename, False
MsgBox "Done", vbInformation
End If
Exit Sub
ElseIf Err.Number <> 0 Then
MsgBox Err.Number & ":" & Err.Description, vbCritical
Exit Sub
End If
MsgBox "Upload Complete", vbInformation
End Sub
Thank for any help
You'll have to rewrite some. Without looping through Tables collection and testing against each name, every method seems to involve handling an error. Here is one:
Function TableExists(strTableName As String) As Boolean
On Error Resume Next
TableExists = IsObject(CurrentDb.TableDefs(strTableName))
End Function
Call the function:
If TableExists("YourTableName") = True Then
More examples in How to check if a table exists in MS Access for vb macros
Related
Still new to access so not sure if this is even possible or if I should just add a separate button, basically I have written code to import excel documents and I need the form to refresh/requery once the import has been completed.
I've tried both me.refresh and me.requery however the form doesn't update.
Private Sub ImportBlacklist_Click()
Dim SelectedFile As String
Dim FilePicker As FileDialog
Dim SQLdelete As String
Set FilePicker = Application.FileDialog(msoFileDialogFilePicker)
FilePicker.AllowMultiSelect = False
FilePicker.Filters.Add "Excel", "*.xls*", 1
FilePicker.InitialFileName = "C:\Users\"
FilePicker.Title = "Select Suppression List Location..."
FilePicker.Show
If FilePicker.SelectedItems.Count <> 0 Then
SelectedFile = FilePicker.SelectedItems(1)
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Blacklist", SelectedFile, True
MsgBox ("Import Success")
End If
Exit Sub
Me.Requery
ErrorHandler:
MsgBox "There was an Error: " & Err & ": " & Error(Err)
End Sub
The import all works perfectly as intended, I just need it to update the form once the MsgBox has closed
You have
Exit Sub
Me.Requery
Me.Requery would do the job, but it isn't executed because of Exit Sub before.
Switch the two lines.
Wanting to check this Exit Sub at the top isn't going to cause me other problems. It seems to work, added to rest of my code for reference.
Everything from 'Establish File Extension type has worked to date/to this point. Unsure if just showing the below segment of code is sufficient to answer the question.
If invalid > 0 Then mbResult = MsgBox("Something's missing. Please check and try again. There are " & invalid & " incomplete fields.", _
vbOKOnly)
Select Case mbResult
Case vbOK
Exit Sub
End Select
'Establish File Extension type
With Destwb
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End If
End With
FileExtStr = ".xlsm"
FileFormatNum = 52
'Save the new workbook and close it
TempFilePath = ("www.mysharepoint.com") & "\"
TempFileName = Range("A1").Text
'Confirm Submission
mbResult = MsgBox("This submission cannot be undone. Would you like to continue?", _
vbYesNo)
Select Case mbResult
Case vbNo
Exit Sub
End Select
'Build .SaveAs file Name based on variables established previously
With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Application.DisplayAlerts = True
ThisWorkbook.Activate
'Display successful submission message
MsgBox ("Thank you, your assessment has been successfully submitted.")
ActiveSheet.Protect
End Sub
You can change these lines:
If invalid > 0 Then mbResult = MsgBox("Something's missing. Please check and try again. There are " & invalid & " incomplete fields.", _
vbOKOnly)
Select Case mbResult
Case vbOK
Exit Sub
End Selec
to this:
If invalid > 0 Then
MsgBox "Something's missing. Please check and try again. There are " & _
invalid & " incomplete fields.", vbOKOnly
Exit Sub
End If
The following code checks if file is open, if not, it opens it and copies something into it. It works fine on my computer. Will it work, when the file is shared and another user opens the file? Will my code detect it?
Sub copy_to_boss()
On Error Resume Next
team = "boss.xlsm"
Set fileBoss = Workbooks(team)
fileIsOpen = Not fileBoss Is Nothing
If fileIsOpen = True Then
MsgBox "The following file is open " & team & " - close it."
Else
MsgBox "I will open the following file " & team
Workbooks.Open Filename:=team
ActiveWorkbook.Worksheets("List1").Cells(1, 1).Value = "10"
End If
End Sub
Try this:
Sub test_LockFile()
Dim sFile As String
Dim sLockFile As String
Dim objFSO As Object
'Trick: Each Excel file in use has a temporary file companion with prefix "~$"
' (e.g. "test.xlsm" ... "$~test.xlsm")
'Define sLockFile
sFile = ThisWorkbook.Name
sLockFile = ThisWorkbook.Path & "\~$" & sFile
'FileSystemObject, late Binding ohne Nutzung von IntelliSense und autom. Konstanten
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Show message if file is locked
If objFSO.FileExists(sLockFile) Then
MsgBox "The file " & sLockFile & " is locked by some user.", vbInformation, sFile & " is locked"
Else
MsgBox "The file is available", vbInformation, sFile
End If
End Sub
You can use something like this to check if the file is in use:
Public Function IsFileLocked(PathName As String) As Boolean
On Error GoTo ErrHandler
Dim i As Integer
If Len(Dir$(PathName)) Then
i = FreeFile()
Open PathName For Random Access Read Write Lock Read Write As #i
Lock i 'Redundant but let's be 100% sure
Unlock i
Close i
Else
Err.Raise 53
End If
ExitProc:
On Error GoTo 0
Exit Function
ErrHandler:
Select Case Err.Number
Case 70 'Unable to acquire exclusive lock
IsFileOpen = True
Case Else
MsgBox "Error " & Err.Number & " (" & Err.Description & ")"
End Select
Resume ExitProc
Resume
End Function
I am trying to make this msoFileDialogOpen allow the user to select multiple files. Is there a better way to do this:
Public Sub Function3_FileExplorer()
' Start File Explorer to select file containing data (simple GUI, much
' easier than coding vFileName)
vuserChoiceDataFileNumber = InputBox("Enter the number of files you want to select.")
With Application.FileDialog(msoFileDialogOpen)
Select Case IsNumeric(vuserChoiceDataFileNumber)
Case True
If VarType(vuserChoiceDataFileNumber) = 2 Or 3 Then
iuserChoiceDataFileNumber = CInt(vuserChoiceDataFileNumber)
End If
Case False
MsgBox (vuserChoiceDataFileNumber & " is not an integer.")
.AllowMultiSelect = False
End Select
.Show
End With
Exit Sub
On Error GoTo ErrorHandler
.AllowMultiSelect = True
ErrorHandler:
MsgBox "Error detected" & vbNewLine & "Error" & Err.Number & ": " & _
Err.Description, vbCritical, "Error Handler: Error " & Err.Number
MsgBox "If you want to force the program to run, go to the line below and " & _
"insert a ' mark to comment the line out." & vbNewLine & _
"On Error GoTo ErrorHandler", vbCritical, "Error Handler: Error " & Err.Number
End Sub
Yes, you can make this much simpler by not asking the user how many files they want to open--just let them select as many as they want.
Public Sub Function3_FileExplorer()
' Start File Explorer to select file containing data (simple GUI, much easier than coding vFileName)
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.FilterIndex = 2
If .Show Then
Dim file As Variant
For Each file In .SelectedItems
' do something with the file, for example, open it:
Application.Workbooks.Open (file)
Next file
End If
End With
End Sub
I am trying to use msoFileDialogOpen to retrieve the corresponding filename the user selected. Here is my clumsy code so far:
Public Sub Function3_FileExplorer()
' Start File Explorer to select file containing data (simple GUI, much easier than coding vFileName)
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
If .Show Then
Dim file As Variant
For Each file In .SelectedItems
.SelectedItems Path
End If
End With
ErrorHandler:
MsgBox "Error detected" & vbNewLine & "Error" & Err.Number & Err.Line
Err.Description , vbCritical, "Error Handler: Error " & Err.Number
End Sub
When I run this program I get the error message:
Compile error:
Invalid use of property
I think using property .SelectedItems is the right thing to do here but I'm not sure how to take that filename and store it as a variant.
EDIT: the revised code (does this do what I want it to do?)
Public Sub Function3_FileExplorer()
Dim file As Variant
' Start File Explorer to select file containing data (simple GUI, much easier than coding vFileName)
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
If .Show Then
file = .SelectedItems(1)
Path = file
End If
End With
MsgBox file
Exit Sub
ErrorHandler:
MsgBox "Error detected" & vbNewLine & "Error" & Err.Number & _
Err.Description, vbCritical, "Error Handler: Error " & Err.Number
End Sub
This is basically what you want (it's not clear what you really want to do with the file name):
Public Sub Function3_FileExplorer()
Dim file As Variant
' Start File Explorer to select file containing data (simple GUI, much easier than coding vFileName)
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
If .Show Then
file = .SelectedItems(1)
End If
End With
MsgBox file
Exit Sub
ErrorHandler:
MsgBox "Error detected" & vbNewLine & "Error" & Err.Number & _
Err.Description, vbCritical, "Error Handler: Error " & Err.Number
End Sub