I have a macro files with file extension of .DO Files(.DO). I Open a file through vb.net
application and to also open a macro. by using that macro I need to format that word Document. I
tried a lot but no use . I try to Select some area of word file but it will leads to error:
Object reference not set to instance of object
Private sub beginFormatting
ls_inipath = System.Windows.Forms.Application.StartupPath & "\"
ls_Document = GetIniValue("Remove_Pages", "doc_name", txtFileName.Text)
Dim what As Object = Word.WdGoToItem.wdGoToLine
Dim which As Object = Word.WdGoToDirection.wdGoToLast
Dim SelectionOne As Selection
Dim returnValue As Range = SelectionOne.GoTo(what, which, Nothing,
Nothing)
SelectionOne.EndKey(WdUnits.wdStory, WdMovementType.wdMove)
end sub
Related
I am using below code to get the created date of a workbook.
Dim mFile As String
mFile = "C:\User\User.Name\Test\Test.xlsx"
Debug.Print CreateObject("Scripting.FileSystemObject").GetFile(mFile).DateCreated
However to my surprise, this returns the date when the file is created in the directory. If you copy the file to another folder, above will return that time and date it was copied (created).
To actually get the original created date, I tried using BuiltinDocumentProperties method. Something like below:
Dim wb As Workbook
Set wb = Workbooks.Open(mfile) '/* same string as above */
Debug.Print wb.BuiltinDocumentProperties("Creation Date")
Above does return the original date the file was actually created.
Now, I have hundreds of file sitting in a directory that I need to get the original creation date. I can certainly use above and look over the files, but opening and closing all of it from a shared drive takes some time. So I was wondering, if I can get the BuiltinDocumentProperties without opening the file(s) like using the first code above which is a lot faster and easier to manage.
If you somebody can point me to a possible solution, that would be great.
Try something like this. The key is the special DSO object.
Imports Scripting
Private Sub ReadProperties()
Dim pathName As String = "C:\yourpathnamehere"
Dim Fso As FileSystemObject = New Scripting.FileSystemObject
Dim fldr As Folder = Fso.GetFolder(pathName)
Dim objFile As Object = CreateObject("DSOFile.OleDocumentProperties")
Dim ResValue As String = Nothing
For Each f In fldr.Files
Try
objFile.Open(f)
ResValue = objFile.SummaryProperties.DateCreated
' Do stuff here
objFile.Close
Catch ex As Exception
'TextBox1.Text = ex.Message
End Try
Application.DoEvents()
Next
End Sub
I'm getting this error, "Microsoft Excel is waiting for another application to complete an OLE action" when trying to automate a PDF string search and record findings in excel. For certain PDFs this error is not popping. I assume this is due to the less optimized PDFs taking a longer time to search string while indexing page by page.
To be more precise, I have a workbook containing two sheets. One contains a list of PDF file names and the other has a list of words that I want to search. From the file list the macro would open each PDF file and take each word from the list of words and perform a string search. If found it would record each finding in a new sheet in the same workbook with the file name and the found string.
Below is the code I'm struggling with. Any help is welcome.
Public Sub SearchWords()
'variables
Dim ps As Range
Dim fs As Range
Dim PList As Range
Dim FList As Range
Dim PLRow As Long
Dim FLRow As Long
Dim Tracker As Worksheet
Dim gapp As Object
Dim gAvDoc As Object
Dim gPDFPath As String
Dim sText As String 'String to search for
FLRow = ActiveWorkbook.Sheets("List Files").Range("B1").End(xlDown).Row
PLRow = ActiveWorkbook.Sheets("Prohibited Words").Range("A1").End(xlDown).Row
Set PList = ActiveWorkbook.Sheets("Prohibited Words").Range("A2:A" & PLRow)
Set FList = ActiveWorkbook.Sheets("List Files").Range("B2:B" & FLRow)
Set Tracker = ActiveWorkbook.Sheets("Tracker")
'For each PDF file list in Excel Range
For Each fs In FList
'Initialize Acrobat by creating App object
Set gapp = CreateObject("AcroExch.App")
'Set AVDoc object
Set gAvDoc = CreateObject("AcroExch.AVDoc")
'Set PDF file path to open in PDF
gPDFPath = fs.Cells.Value
' open the PDF
If gAvDoc.Open(gPDFPath, "") = True Then
'Bring the PDF to front
gAvDoc.BringToFront
'For each word list in the range
For Each ps In PList
'Assign String to search
sText = ps.Cells.Value
'This is where the error is appearing
If gAvDoc.FindText(sText, False, True, False) = True Then
'Record findings
Tracker.Range("A1").End(xlDown).Offset(1, 0) = fs.Cells.Offset(0, -1).Value
Tracker.Range("B1").End(xlDown).Offset(1, 0) = ps.Cells.Value
End If
Next
End If
'Message to display once the search is over for a particular PDF
MsgBox (fs.Cells.Offset(0, -1).Value & " assignment complete")
Next
gAvDoc.Close True
gapp.Exit
set gAVDoc = Nothing
set gapp = Nothing
End Sub
I have now found the answer to this problem.
I'm using Acrobat Pro and whenever I open a PDF file, it opens with limited features due to Protected View settings. If I disable this function or if I click Enable All Features and save changes to the PDF files, VBA macro runs smooth.
It's funny, I'm posting an answer to my own problem.
I have a simple macro that opens a Word Document using Excel. I made sure the Word Object Library is properly referenced but when running this macro it freezes after Documents.Open is called (based on me seeing where it fails in the debugger). I don't know if it is a OLE Automation Error but the macro freezes and I have to force close Excel.
Public Const Dir = "C:/Temp/"
Public Const File = "temp.docx"
Public Sub OpenFile()
Dim f As String: f = Dir & File
Dim oWord As Object, oDoc As Object
Set oWord = CreateObject("Word.Application")
Set oDoc = oWord.Documents.Open(f)
oDoc.Visible = True
End Sub
I get this message as well: (even though there is no other application open)
Is there an alternative to opening a file with Excel and how I rewrite my program?
As requested - this is a common problem
You should change your Dir variable - that's a reserved name - and you're probably getting a Word error you can't see when you try to open that "file".
You should also change your File variable name too - that can be a reserved word too depending on references you've set
Added Comment:
With regard to it freezing - you can remove the oDoc.Visible = True statement and replace it with oWord.Visible = True BEFORE the problem statement Set oDoc = oWord.Documents.Open(f). That would popup the error indicating you had a problem with your filename
I need to add text string to all files on a folder, as a footer
For example, on the folder on the path and called C:\mobatchscripts\
I have a random number of txt files, with text.
I want to add a line for example "text" on each of the text files on the folder
I have little knowledge of vba programming, but for what I have read I can use append, but I need something that loop on the files on the folder, and modify them.
So far I tried this:
Sub footer()
Dim FolderPath As String
Dim FileName As String
Dim wb As Excel.Workbook
FolderPath = "C:\mobatchscripts\"
FileName = Dir(FolderPath)
Do While FileName <> ""
Open FileName For Append As #1
Print #1, "test"
Close #1
FileName = Dir
Loop
End Sub
But seems that its not looking into the files, or appending the text.
On the assumption that you're writing to text files (I see "batchscripts" in the path), you need a reference to the Microsoft Scripting Runtime (Within the VBE you'll find it in Tools, References)
Option Explicit
Public Sub AppendTextToFiles(strFolderPath As String, _
strAppendText As String, _
blnAddLine As Boolean)
Dim objFSO As FileSystemObject
Dim fldOutput As Folder
Dim filCurrent As File
Dim txsOutput As TextStream
Set objFSO = New FileSystemObject
If objFSO.FolderExists(strFolderPath) Then
Set fldOutput = objFSO.GetFolder(strFolderPath)
For Each filCurrent In fldOutput.Files
Set txsOutput = filCurrent.OpenAsTextStream(ForAppending)
If blnAddLine Then
txsOutput.WriteLine strAppendText
Else
txsOutput.Write strAppendText
End If
txsOutput.Close
Next
MsgBox "Wrote text to " & fldOutput.Files.Count & " files", vbInformation
Else
MsgBox "Path not found", vbExclamation, "Invalid path"
End If
End Sub
I'd recommend adding error handling as well and possibly a check for the file extension to ensure that you're writing only to those files that you want to.
To add a line it would be called like this:
AppendTextToFiles "C:\mobatchscripts", "Test", True
To just add text to the file - no new line:
AppendTextToFiles "C:\mobatchscripts", "Test", False
Alternatively, forget the params and convert them to constants at the beginning of the proc. Next time I'd recommend working on the wording of your question as it's not really very clear what you're trying to achieve.
I'd like to be able to delete individual files that are stored as attachments in an Access Database through VB.Net
I've managed to get storing, opening and "downloading" from an Access Database to work effectively, but the last piece of the puzzle would be to allow my end-user to delete an individual file in the attachments field.
This seems to be much harder than the other options as I can only seem to find information on how to delete the entire database entry, not just a single attachment. It gets even more complicated if there are more than one attachments stored against the entry.
I am using the following code to check what happens when the datagrid is clicked:
If e.ColumnIndex = ViewFileColum.Index Then
'Get the file name and contents for the selected attachment.
Dim gridRow = childgrid.Rows(e.RowIndex)
Dim tableRow = DirectCast(gridRow.DataBoundItem, DataRowView)
Dim fileName = CStr(tableRow(FILE_NAME_COLUMN_NAME))
Dim fileContents = GetFileContents(DirectCast(tableRow(FILE_DATA_COLUMN_NAME), Byte()))
DisplayTempFile(fileName, fileContents)
End If
If e.ColumnIndex = DownloadFileColumn.Index Then
'Get the file name and contents for the selected attachment.
MoveFile = True
Dim gridRow = childgrid.Rows(e.RowIndex)
Dim tableRow = DirectCast(gridRow.DataBoundItem, DataRowView)
Dim fileName = CStr(tableRow(FILE_NAME_COLUMN_NAME))
Dim fileContents = GetFileContents(DirectCast(tableRow(FILE_DATA_COLUMN_NAME), Byte()))
DisplayTempFile(fileName, fileContents)
End If
I want to add a third section that states if the DeleteFileColumn button is clicked then to remove that particular attachment from the database, but this doesn't seem possible.
When retrieving the information for the above two options, I use the following code:
Dim tempFolderPath = Path.GetTempPath()
Dim tempFilePath = Path.Combine(tempFolderPath, fileName)
'If the specified file exists, add a number to the name to differentiate them.
If File.Exists(tempFilePath) Then
Dim fileNumber = 1
Do
tempFilePath = Path.Combine(tempFolderPath,
String.Format("{0} ({1}){2}",
Path.GetFileNameWithoutExtension(fileName),
fileNumber,
Path.GetExtension(fileName)))
fileNumber += 1
Loop Until Not File.Exists(tempFilePath)
End If
'Save the file and open it.
'If "DOWNLOAD" button is clicked
If MoveFile = True Then
File.WriteAllBytes(SaveLocation & "\" & Path.GetFileNameWithoutExtension(fileName) & Path.GetExtension(fileName), fileContents)
MoveFile = False
'If "OPEN" button is clicked
Else
File.WriteAllBytes(tempFilePath, fileContents)
Dim attachmentProcess = Process.Start(tempFilePath)
If attachmentProcess Is Nothing Then
'Remember the file and try to delete it when this app closes.
tempFilePaths.Add(tempFilePath)
Else
'Remember the file and try to delete it when the associated process exits.
attachmentProcess.EnableRaisingEvents = True
AddHandler attachmentProcess.Exited, AddressOf attachmentProcess_Exited
tempFilePathsByProcess.Add(attachmentProcess, tempFilePath)
End If
End If
This code copies the information before opening it, so I don't ever actually deal with the file in the database directly. I've used adapted this code from another example I found online, but am having a hard time working out how to physically deal with the file on the database, or if its even possible?
Thanks
You need to create an Access DAO Recordset2 object for the attachments field, find the record corresponding to the specific attachment you want to delete, and then Delete() that record.
The following example will remove a document named "testDocument.pdf" from the attachments field for the record where ID=1:
' required COM reference:
' Microsoft Office 14.0 Access Database Engine Object Library
'
' Imports Microsoft.Office.Interop.Access.Dao
'
Dim dbe As New DBEngine
Dim db As Database = dbe.OpenDatabase("C:\Users\Public\Database1.accdb")
Dim rstMain As Recordset = db.OpenRecordset(
"SELECT Attachments FROM AttachTest WHERE ID=1",
RecordsetTypeEnum.dbOpenDynaset)
rstMain.Edit()
Dim rstAttach As Recordset2 = CType(rstMain.Fields("Attachments").Value, Recordset2)
Do Until rstAttach.EOF
If rstAttach.Fields("FileName").Value.Equals("testDocument.pdf") Then
rstAttach.Delete()
Exit Do
End If
rstAttach.MoveNext()
Loop
rstAttach.Close()
rstMain.Update()
rstMain.Close()
db.Close()