I am trying to find an existing file in a folder location
Current Code:
Dim FileExistsbol As Boolean
Dim stFileName As String
stFileName = "H:\Test File.txt"
stFileName = Trim(stFileName)
FileExistsbol = dir(stFileName) <> vbNullString
If FileExistsbol Then Kill stFileName
Error:
The error message is: Type Mismatch
VBA debugs on this line:
FileExistsbol = dir(stFileName) <> vbNullString
The file does exist so unsure how to resolve this - Any ideas?
I would get rid of the FileExistsbol variable and then just do something like:
If Dir(stFileName) <> "" Then
Kill stFileName
End If
Related
I've found this code that should find two matching pdf-filenames and merges them into 1 pdf-file always in the same order. File 1 then File 2.
The code matches filenames based on the first part of the filename, before the AnotherWord 2014.pdf or before SomeWord.pdf.
Example document name1: John Doe SomeWord.pdf
Example document name2: John Doe AnotherWord 2014.pdf
I use PDF reDirect Pro v2.5.2 (freeware) and a reference to the program.
The problem I have is that the line
Dim oPDF As New PDF_reDirect_v25002.Batch_RC_AXD
That gives me the error:
User-defined type not defined
How can I fix this?
This is the whole code:
Private Sub Knop0_Click()
'Only works with PDF reDirect Pro v2.5.2
'And needs to have a reference to PDF_reDirect_v2500 and PDF reDirect Pro Remote Control
Dim fs As Object
Dim fld As Object
Dim fld2 As Object
Dim objFile As Object
Dim objFile2 As Object
Set fs = CreateObject("Scripting.FileSystemObject")
Dim oPDF As New PDF_reDirect_v25002.Batch_RC_AXD
Dim TempBool As Boolean
Dim Files_to_Merge(1) As String
Dim ObjFileName() As String
Dim CellNameValue() As String
Dim ofn As String
Dim cnv As String
Dim i As Integer
Set fld = fs.GetFolder("C:\pdf")
Set fld2 = fs.GetFolder("C:\pdf\merged")
i = 1
For Each objFile In fld.files
For Each objFile2 In fld.files
CellNameValue() = Split(objFile.Name, " SomeWord.pdf")
cnv = CellNameValue(0)
ObjFileName() = Split(objFile2.Name, " AnotherWord 2014.pdf")
ofn = ObjFileName(0)
Files_to_Merge(1) = fld & "\" & ofn & " AnotherWord 2014.pdf"
Files_to_Merge(0) = fld & "\" & cnv & " SomeWord.pdf"
If StrComp(ofn, cnv) = 0 Then
With oPDF
TempBool = .Utility_Merge_PDF_Files(fld2 & "\" & ofn & " AnotherWord 2014.pdf", Files_to_Merge) 'The file merges here unless it generates an error and goes to If Not TempBool Then...
If Not TempBool Then
MsgBox "An Error Occured: etc."
Else
'Optional
End If
End With
End If
i = i + 1
Next objFile2
i = i + 1
Next objFile
Set oPDF = Nothing
End Sub
As I said in my comments this should work assuming your trial Pro version will still allow this feature.
You just have to make sure you're using the correct version of the object that has been registered on your system.
Can you delete the line Dim oPDF As New PDF_reDirect_v25002.Batch_RC_AXD and start retyping it from scratch - not copy/pasting? Does the Object for the tool show up in Intellisense as you start typing PDF_Re
Put in the object that it finds PDF_reDirect_v2500 if that's what it is - then type the . and start typing Batch to fill in the last part. You have to use the current version of the object reference.
Compile your code and see if gets past that line
I'm recycling code from an old database.
For one person, located half way across the country, I believe there may be some connection issue.
Public Function BackUpBackend()
Dim Source As String
Dim Target As String
Dim retval As Integer
Source = "\\network\backend\accessfile.accdb"
Target = "\\network\backend\backup\"
Target = Target & Format(Date, "mm-dd") & "#"
Target = Target & Format(Time, "hh-mm") & ".accdb"
retval = 0
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
retval = objFSO.CopyFile(Source, Target, True)
Set objFSO = Nothing
End Function
Is there any way to detect connection errors in this code? And if there is, can the connection be re-established or just stop the backup process all together when the issue comes up?
In VBA you can do
On Error Resume Next
which will continue past errors. This can be dangerous though, so it's often best to switch on error handling again as soon as possible with
On Error Goto 0
You can define custom handlers for errors that crop up that you want to take specific action on:
From the VBA Reference:
Sub InitializeMatrix(Var1, Var2, Var3, Var4)
On Error GoTo ErrorHandler
. . .
Exit Sub
ErrorHandler:
. . .
Resume Next
End Sub
So you might do something like: (I've not tested)
Public Function BackUpBackend()
Dim Source As String
Dim Target As String
Dim retval As Integer
Source = "\\network\backend\accessfile.accdb"
Target = "\\network\backend\backup\"
Target = Target & Format(Date, "mm-dd") & "#"
Target = Target & Format(Time, "hh-mm") & ".accdb"
retval = 0
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
On Error Goto ErrorHandler
retval = objFSO.CopyFile(Source, Target, True)
Set objFSO = Nothing
On Error Goto 0
Exit Function
ErrorHandler:
MsgBox("Backup failed. If this happens often contact IT", vbExclamation )
End Function
I'm trying to use this code to copy a file to a new folder and add the file path/name to the DocName column in tblFileAttachments.
When I select the file to add, I keep getting this error "Run-time error 3162...You tried to assign the Null Value to a variable that is not a Variant data type."
Here are the tables I have
tblFileAttachments
- DocID
- DocName
- RequestID_FK
tblRequests
- RequestID
- PFName
- PLName
- PBusinessName
I have a form based on tblFileAttachments with DocID, DocName and RequestID_FK fields. I also have a "Add File" button with the following code:
Private Sub btnAttachFile_Click()
Dim rsFile As DAO.Recordset
Dim strFilePath As String, strFilename As String
strFilePath = fSelectFile()
If strFilePath & "" <> "" Then
strFilename = Mid(strFilePath, InStrRev(strFilePath, "\") + 1)
With CurrentDb.OpenRecordset("tblFileAttachments")
.AddNew
!DocID = Me.DocID
!FilePath = strFilePath
!FileName = strFilename
.Update
End With
End If
End Sub
Debugging the error, it highlights
!DocID = Me.DocID
DocID is probably an Autonumber column?
Then don't assign it at all while creating the new record, simply leave out this line:
!DocID = Me.DocID
The ID will be generated automatically.
I have a Access DB containing several different tables, each with a different structure (number & names of fields, number of rows, title).
What I would like to do is to export all these tables into txt files, with a given separator ("|"), point as decimal separator, quotes for strings.
I have browsed the internet and what I got was:
use DoCmd.TransferText acExportDelim command
save a customized export specification and apply it
I get an error messagge ("object does not exist") and I think it is related to the fact that the export specification is "sheet-specific", i.e. does not apply to tables with different fields and fieldnames.
Can you help me?
thanks!!
EDIT.
I post also the original code I run. As I said before, I am new to VBA, so I just looked for a code on the web, adapted it to my needs, and run.
Public Sub ExportDatabaseObjects()
On Error GoTo Err_ExportDatabaseObjects
Dim db As Database
Dim db As DAO.Database
Dim td As TableDef
Dim sExportLocation As String
Dim a As Long
Set db = CurrentDb()
sExportLocation = "C:\" 'Do not forget the closing back slash! ie: C:\Temp\
For a = 0 To db.TableDefs.Count - 1
If Not (db.TableDefs(a).Name Like "MSys*") Then
DoCmd.TransferText acExportDelim, "Export_specs", db.TableDefs(a).Name, sExportLocation & db.TableDefs(a).Name & ".txt", True
End If
Next a
Set db = Nothing
MsgBox "All database objects have been exported as a text file to " & sExportLocation, vbInformation
Exit_ExportDatabaseObjects:
Exit Sub
Err_ExportDatabaseObjects:
MsgBox Err.Number & " - " & Err.Description
Resume Exit_ExportDatabaseObjects
End Sub
Before running the code, I manually exported the first table saving the Export_specs to a file.
Consider a db with two tables, A and B.
When I run the code A is properly exported, then I get the following errore message "3011 - The Microsoft Access database engine could not find the object 'B#txt'. Make sure the object exists and that you spell its name and the path name correctly. If 'B#txt' is not a local object, check your network connection or contact the server administration".
So, it's kind of complex. I've created a routine that imports files using ImportExport Specs, you should be able to easily adapt to your purpose. The basic operation is to create a spec that does exactly what you want to one file. Then, export this spec using this code:
Public Function SaveSpecAsXMltoTempDirectory(sSpecName As String)
Dim oFSO As FileSystemObject
Dim oTS As TextStream
Set oFSO = New FileSystemObject
Set oTS = oFSO.CreateTextFile("C:\Temp\" & sSpecName & ".xml", True)
oTS.Write CurrentProject.ImportExportSpecifications(sSpecName).XML
oTS.Close
Set oTS = Nothing
Set oFSO = Nothing
End Function
Then open this file in Notepad and replace the file name with some placeholder (I used "FILE_PATH_AND_NAME" in this sample). Then, import back into database using this code:
Public Function SaveSpecFromXMLinTempDirectory(sSpecName As String)
Dim oFSO As FileSystemObject
Dim oTS As TextStream
Dim sSpecXML As String
Dim oSpec As ImportExportSpecification
Set oFSO = New FileSystemObject
Set oTS = oFSO.OpenTextFile("C:\Temp\" & sSpecName & ".xml", ForReading)
sSpecXML = oTS.ReadAll
For Each oSpec In CurrentProject.ImportExportSpecifications
If oSpec.Name = sSpecName Then oSpec.Delete
Next oSpec
Set oSpec = CurrentProject.ImportExportSpecifications.Add(sSpecName, sSpecXML)
Set oSpec = Nothing
oTS.Close
Set oTS = Nothing
Set oFSO = Nothing
End Function
Now you can cycle thru the files and replace the placeholder in the spec with the filename then execute it using this code:
Public Function ImportFileUsingSpecification(sSpecName As String, sFile As String) As Boolean
Dim oSpec As ImportExportSpecification
Dim sSpecXML As String
Dim bReturn As Boolean
'initialize return variable as bad until function completes
bReturn = False
'export data using saved Spec
' first make sure no temp spec left by accident
For Each oSpec In CurrentProject.ImportExportSpecifications
If oSpec.Name = "Temp" Then oSpec.Delete
Next oSpec
sSpecXML = CurrentProject.ImportExportSpecifications(sSpecName).XML
If Not Len(sSpecXML) = 0 Then
sSpecXML = Replace(sSpecXML, "FILE_PATH_AND_NAME", sFile)
'now create temp spec to use, get template text and replace file path and name
Set oSpec = CurrentProject.ImportExportSpecifications.Add("Temp", sSpecXML)
oSpec.Execute
bReturn = True
Else
MsgBox "Could not locate correct specification to import that file!", vbCritical, "NOTIFY ADMIN"
GoTo ExitImport
End If
ExitImport:
On Error Resume Next
ImportFileUsingSpecification = bReturn
Set oSpec = Nothing
Exit Function
End Function
Obviously you'll need to find the table name in the spec XML and use a placeholder on it as well. Let me know if you can't get it to work and i'll update for export.
I just starting with access and cant make things work...
trying to make simple sub that opens excell sheet and compares some values with table in access.
I am using this link as a reference:
http://www.utteraccess.com/wiki/index.php/Recordsets_for_Beginners
Private Sub Command2_Click()
Dim wb As Workbook
Set wb = openXLS
If Not wb Is Nothing Then
Dim rcs As DAO.Recordset
Dim db As Database
Set db = CurrentDb
Set rcs = db.OpenRecordset(TABLE_PRODUCTS)
Dim itemNo As String
For i = 1 To tools.LRow(wb.Sheets("Sheet1"), "A")
itemNo = wb.Sheets("Sheet1").Cells(i, "A").Value
rcs.FindFirst "ItemNo = " & itemNo 'error here, runtime error 3251
'operation is not supported for this type of object
If rcs.NoMatch = True Then
MsgBox "nomatch"
Else
MsgBox "OK"
End If
Next i
wb.Close
rcs.Close
Set wb = Nothing
Set rcs = Nothing
End If
End Sub
openXLS is a function that opens and returns workbook.
LRow returns last row in the column
i get runtime error 3251 operation is not supported for this type of object (marked in the coments)
You can't use FindFirst with table type recordsets. You will need to explicitly specify a dynaset recordset:-
Set rcs = db.OpenRecordset(TABLE_PRODUCTS, dbOpenDynaset)
You should do like this because i think you are not getting any records in recordset
if not rcs.EOF then
rcs.FindFirst "ItemNo = " & itemNo 'error here, runtime error 3251
'operation is not supported for this type of object
If rcs.NoMatch = True Then
MsgBox "nomatch"
Else
MsgBox "OK"
End If
end if
Update
Can you try using seek method instead of findfirst
rcs.Seek "=", itemNo
Update 2
First set index of your primary id like
rcs.index= "Id" -- do this after you create DAO recordset
Then try this
rcs.Seek Comparison:="=", itemNo:=itemNo