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.
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 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
Run-time error '91':
Object variable or With block variable not set
Sub findfilmnameusingeventhandler()
Sheet1.Activate
Dim searchrange As Range
Dim filmname As String
Dim releasedate As Integer
Dim filmtofind As String
Set searchrange = Range("b3", Range("b2").End(xlDown))
filmname = InputBox("Type the movie")
filmtofind = searchrange.Find(what:=filmname)
'filmtofind = Range("b2:b15").Find(what:=filmname)
MsgBox filmtofind & " is the movie "
End Sub`
Hi, Thank you for reviewing my question. I've declared a range variable & use it to search a string "filmtofind = searchrange.Find(what:=filmname)" & it fails with run time error
Run-time error '91':
Object variable or With block variable not set
however I can search for same range with a declared range
filmtofind = Range("b2:b15").Find(what:=filmname) & can find a variable. COuld someone please point the mistake?
The film you are entering does not exist in the list, try an error check like this:
Sub something()
Dim searchrange As Range
Dim filmname As String
Dim releasedate As Integer
Dim filmtofind As String
Set searchrange = Range("B3", Range("B2").End(xlDown))
filmname = InputBox("Type the movie")
If WorksheetFunction.CountIf(searchrange, filmname) > 0 Then
filmtofind = searchrange.Find(what:=filmname)
Else
filmtofind = "Film not found!"
End If
'filmtofind = Range("b2:b15").Find(what:=filmname)
MsgBox filmtofind & " is the movie "
End Sub
I have a query "myQuery" that returns more than 65,000 records, and as such, cannot be exported to one .xlsx file.
I'm attempting to break up this output to multiple files.
I'm still very much a beginner with VBA, but I've put the following together as best I can from research. This code is intended to iterate through the queried data, then output a new file for each 65,000 records.
Private Sub btnfrm1export_Click()
Dim outputFileName As String
Dim dlgOpen As FileDialog
Dim numFiles As Integer
Dim rs As String
Dim numr As Integer
Dim sql As String
Dim rec As Recordset
'Allows user to pick destination for files and gives value to sItem.
Set dlgOpen = Application.FileDialog(msoFileDialogFolderPicker)
With dlgOpen
.Title = "Select a Folder"
.AllowMultiSelect = False
If .Show <> -1 Then
sItem = .SelectedItems(1)
End If
End With
'Counts the records in myQuery to give the number of files needed to numFiles, assuming 60,000 records per file.
Set rec = CurrentDb.OpenRecordset("myQuery")
numFiles = Round(rec.RecordCount / 60000, 0)
numr = 1
' Changes the SQL of the query _vba in the current Database to select 60000 records from myQuery
rs = "SELECT TOP 60000 myQuery.* FROM myQuery"
CurrentDb.QueryDefs("_vba").sql = rs
'Defines SQL for clearing top 60000 (used in the following loop).
sql = "DELETE TOP 60000 myQuery.* FROM myQuery"
'Loops once to create each file needed
Do While numFiles > 0
'Sets a file name based on the destination folder, the file number numr, and information from a combobutton cbo1 on Form frm1.
outputFileName = sItem & "\" & Forms!frm1!cbo1 & "_Report_Pt" & numr & "_" & Format(Date, "yyyyMMdd") & ".xlsx"
'Outputs top 60000 of myQuery records to an excel file.
DoCmd.OutputTo acOutputQuery, "_vba", acFormatXLSX, outputFileName
numFiles = numFiles - 1
numr = numr + 1
'Deletes top 60000 from myQuery.
CurrentDb.Execute sql
Loop
End Sub
However, I'm getting:
Run-time error '2302': Microsoft Access can't save the output data to the file you've selected.
at DoCmd.OutputTo acOutputQuery, "_vba", acFormatXLSX, outputFileName
I do need this to be automated in vba and without pop-ups, etc. Any suggestions to make my code more efficient and proper is appreciated, but the REAL question is how to eliminate the error with DoCmd.OutputTo or make this work.
Thanks for any and all help!
Although the subject line concerns trying to output multiple Excel files, the real issue is trying to create an Excel file from an Access table or query which contains more than 65,000 rows - by using VBA. If VBA is NOT a requirement, then you can export a query or table by right-clicking on the object name, selecting export, then Excel. DO NOT check the box for 'Export data with formatting...' and it will work.
The code shown below was found at: http://www.myengineeringworld.net/2013/01/export-large-access-tablequery-to-excel.html (Created By Christos Samaras) and will properly export a large table/query to Excel
Option Compare Database
Option Explicit
Sub Test()
'Change the names according to your own needs.
DataToExcel "Sample_Table", "Optional Workbook Path", "Optional Target Sheet Name"
'Just showing that the operation finished.
MsgBox "Data export finished successfully!", vbInformation, "Done"
End Sub
Function DataToExcel(strSourceName As String, Optional strWorkbookPath As String, Optional strTargetSheetName As String)
'Use this function to export a large table/query from your database to a new Excel workbook.
'You can also specify the name of the worksheet target.
'strSourceName is the name of the table/query you want to export to Excel.
'strWorkbookPath is the path of the workbook you want to export the data.
'strTargetSheetName is the desired name of the target sheet.
'By Christos Samaras
'http://www.myengineeringworld.net
Dim rst As DAO.Recordset
Dim excelApp As Object
Dim Wbk As Object
Dim sht As Object
Dim fldHeadings As DAO.Field
'Set the desired recordset (table/query).
Set rst = CurrentDb.OpenRecordset(strSourceName)
'Create a new Excel instance.
Set excelApp = CreateObject("Excel.Application")
On Error Resume Next
'Try to open the specified workbook. If there is no workbook specified
'(or if it cannot be opened) create a new one and rename the target sheet.
Set Wbk = excelApp.Workbooks.Open(strWorkbookPath)
If Err.Number <> 0 Or Len(strWorkbookPath) = 0 Then
Set Wbk = excelApp.Workbooks.Add
Set sht = Wbk.Worksheets("Sheet1")
If Len(strTargetSheetName) > 0 Then
sht.Name = Left(strTargetSheetName, 34)
End If
End If
'If the specified workbook has been opened correctly, then in order to avoid
'problems with other sheets that might contain, a new sheet is added and is
'being renamed according to the strTargetSheetName.
Set sht = Wbk.Worksheets.Add
If Len(strTargetSheetName) > 0 Then
sht.Name = Left(strTargetSheetName, 34)
End If
On Error GoTo 0
excelApp.Visible = True
On Error GoTo Errorhandler
'Write the headings in the target sheet.
For Each fldHeadings In rst.Fields
excelApp.ActiveCell = fldHeadings.Name
excelApp.ActiveCell.Offset(0, 1).Select
Next
'Copy the data in the target sheet.
rst.MoveFirst
sht.Range("A2").CopyFromRecordset rst
sht.Range("1:1").Select
'Format the headings of the target sheet.
excelApp.Selection.Font.Bold = True
With excelApp.Selection
.HorizontalAlignment = -4108 '= xlCenter in Excel.
.VerticalAlignment = -4108 '= xlCenter in Excel.
.WrapText = False
With .Font
.Name = "Arial"
.Size = 11
End With
End With
'Adjusting the columns width.
excelApp.ActiveSheet.Cells.EntireColumn.AutoFit
'Freeze the first row - headings.
With excelApp.ActiveWindow
.FreezePanes = False
.ScrollRow = 1
.ScrollColumn = 1
End With
sht.Rows("2:2").Select
excelApp.ActiveWindow.FreezePanes = True
'Change the tab color of the target sheet.
With sht
.Tab.Color = RGB(255, 0, 0)
.Range("A1").Select
End With
'Close the recordset.
rst.Close
Set rst = Nothing
Exit Function
Errorhandler:
DoCmd.SetWarnings True
MsgBox Err.Description, vbExclamation, Err.Number
Exit Function
End Function
An import sub that has been created in access works OK but when DBfailonerror is added a compile error invalid use of property is encountered when the sub is run from the vb editor.
Any advice re: this would be most appreciated. Code is as follows:
Sub Importcl()
'DATA DECLARATIONS
Dim fso As New FileSystemObject
Dim t As TextStream
Dim strFilePath As String
Dim Cnr As String
Dim Cnri As String
Dim Cnrii As String
Dim Cnriii As String
Dim Sqlstr As String
Dim Db As DAO.Database
'SET COUNTERS TO ZERO
Cnr = 0
Cnri = 0
Cnrii = 0
Cnriii = 0
'Point to DB
Set Db = CurrentDb()
'SET TXT FILE PATH
strFilePath = "C:\Users\Vlad\CSV import\EV WORK\Book1.txt"
'ERROR HANLDER FOR TXT FILE PATH AND COUNTING OF TXT FILE LINE ITEMS
If fso.FileExists(strFilePath) Then
Set t = fso.OpenTextFile(strFilePath, ForReading, False)
Do While t.AtEndOfStream <> True
t.SkipLine
Cnr = Cnr + 1
Loop
t.Close
Else: MsgBox ("Txt File not Found - Check File Path")
Exit Sub
End If
'DISPLAY LINE RECORDS COUNTED IN TXT FILE TO BE ADDED TO TABLE
Debug.Print Cntr; " Incl header"
MsgBox (Cnr - 1 & " records to be added")
'COUNT & DISPLAY CURRENT RECORD COUNT IN TARGET TABLE
Cnri = DCount("[Case Date]", "All Caseload Data New")
If MsgBox(Cnri & " -Current Records in table- All Caseload Data New - Continue
with Import?", vbYesNo, "Import") = vbYes Then
Db.Execute _
"INSERT INTO [All Caseload Data New] SELECT * FROM[Text;FMT=Delimited;HDR=Yes;
DATABASE=C:\Users\Dev\CSV import\DEV WORK\].[Book1#txt];"
dbFailOnError
Db.TableDefs.Refresh
Else: Exit Sub
End If
Cnrii = DCount("[Case Date]", "All Caseload Data New")
Cnriii = Cnrii - Cnri
MsgBox (Cnriii & " New records added to table All Caseload Data New")
End Sub
With this code to start ...
Dim db As DAO.database
Dim strInsert As String
strInsert = "INSERT INTO tblFoo (some_text) VALUES ('bar');"
Set db = CurrentDb
Then these 2 Execute statements ..
db.Execute strInsert
dbFailOnError ' triggers error
db.Execute strInsert, dbFailOnError ' compiles without error
Include dbFailOnError on the same line as Execute. Placing dbFailOnError on a separate line triggers that "invalid use of property" compile error.