Issues with Working and Activating Multiple Workbooks excel VBA - excel

I'm having some issues when working with calling and working with multiple workbooks. I have a macro that updates some excel sheets using some data. All 5 of those spreadsheets are assigned a variable with the filename and the file path. When I run a second SUB / Macri to Save and Close all 5 of those workbooks after they are done updating - It doesn't select the right workbooks even though they've been assigned the same variable names as the previous macro. So I believe my issue is - If the workbooks are already open I can't associate a variable too them. - I assume that if the file name and file path are right, the workbooks open can be set as variables and then be able to close them - Thoughts?
Sub CloseWorkbooks()
Dim MB, WB1, WB2, WB3, WB4, WB5 As Workbook
Dim FP1, FN1, FN2, FN3, FN4, FN5 As String
FP1 = "G:\DATA......"
FN5 = "Book1.xlsx"
FN2 = "Book2.xlsx"
FN3 = "Book3.xlsx"
FN4 = "Book4.xlsx"
FN1 = "Book5.xlsx"
Application.DisplayAlerts = False
Set WB1 = Workbooks.Open(Filename:=FP1 & FN1)
WB1.Activate
WB1.Save
'Application.Wait (Now + TimeValue("00:00:05"))
WB1.Close
Set WB2 = Workbooks.Open(Filename:=FP1 & FN2)
WB2.Activate
WB2.Save
'Application.Wait (Now + TimeValue("00:00:05"))
WB2.Close
Set WB3 = Workbooks.Open(Filename:=FP1 & FN3)
WB3.Activate
WB3.Save
Application.Wait (Now + TimeValue("00:00:02"))
WB3.Close
Set WB4 = Workbooks.Open(Filename:=FP1 & FN4)
WB4.Activate
WB4.Save
Application.Wait (Now + TimeValue("00:00:02"))
WB4.Close
Set WB5 = Workbooks.Open(Filename:=FP1 & FN5)
WB5.Activate
WB5.Save
Application.Wait (Now + TimeValue("00:00:02"))
WB5.Close
End Sub
This works if the worksheets are NOT Open, but it doesn't work if the worksheets are open - which is what I want it to accomplish. The previous macro opens all the worksheets and updates them. I want this macro (2nd one shown above) to save and close all the workbooks.
-Thank you.

If you replace your Workbooks.Open(...) with a call to this it should return the workbook if its open, and open and return it if it is not.
Public Function getWorkbookByFileName(ByVal FileName As String) As Workbook
Dim Book As Workbook: Set Book = Nothing
Dim Count As Integer: Count = Application.Workbooks.Count
Dim Index As Integer: Index = 1
Do
If Application.Workbooks(Index).FullName = FileName Then
Set Book = Application.Workbooks(Index)
Exit Do
End If
If Index < Count Then
Index = Index + 1
Else
Exit Do
End If
Loop
If Book Is Nothing Then
Set Book = Application.Workbooks.Open(FileName:=FileName)
End If
Set getWorkbookByFileName = Book
End Function
This is fairly long winded, looking at some of the answers to Detect whether Excel workbook is already open I see that it can be achieved without looping through the workbooks.

This will close the correct workbook.
Sub CloseWorkbooks()
Application.DisplayAlerts = False
Dim wb As Workbook
Dim i As Long
For i = 1 To 6
Set wb = Workbooks.Open(Filename:="G:\DATA......Book" & i & ".xlsx")
Application.Wait (Now + TimeValue("00:00:02"))
wb.Close SaveChanges:=True
Next i
Exit Sub

Related

Unprotect the Excel workbooks in a specified path and refresh the workbook conection and then protect the workbooks

To elaborate(Unprotect the Excel workbooks in a specified path and refresh the workbook conection and then protec the workbooks)
I've a four workbooks in a specific path used by different users. I've used the power query to consolidate the workbooks with my Mastersheet using Data--> Refreshall. Some of the internal team issues I'm in a situation of protecting the workbooks.
After the initiation, the mastersheet won't get refreshed it indicates '[DataFormat.Error] File contains corrupted data.'. When i'm unprotecting the workbook, it worked properly.
So, please help me with this.
Option Explicit
Sub Unlock_Refresh()
Dim wb As Workbook, ws As Worksheet
Dim Filepath As String, Filename As String
Dim n As Long
Const pass = "1519"
Filepath = Worksheets("Sheet2").Range("A1").Value
If Right(Filepath, 1) <> "\" Then Filepath = Filepath & "\"
Filename = Dir(Filepath & "*.xls*")
Application.ScreenUpdating = False
Do While Filename <> ""
Set wb = Workbooks.Open(Filepath & Filename, Password:=pass)
With wb
.Unprotect Password:=pass
.RefreshAll
Application.Wait Now + TimeValue("00:00:10")
.Protect Password:=pass
.Close savechanges:=True
End With
n = n + 1
Filename = Dir
Loop
Application.ScreenUpdating = True
MsgBox n & " workbooks refreshed in " & vbLf & Filepath, vbInformation
End Sub
Don't know if this is related to the issue you're having or not, but there appears to be some logical disconnections in your code.
Line:
Set wb = Workbooks.Open(Filepath & Filename, Password:=pass)
Opens a workbook using a password that would be required only if the book was password protected to open. I note here:
a) this line of code will work even of no 'password-to-open' was set
b) as the code doesn't set a password-to-open, one assumes that is done manually?
Lines:
.Unprotect Password:=pass
.RefreshAll
.Protect Password:=pass
Un-protects the book-structure (and windows), refreshes external data, then re-protects the book-structure (only). I note here:
a) book-structure protection doesn't need to be off, in order to refresh external data
b) this doesn't set the 'password-to-open'
So it's unclear why the un-protect and re-protect logic cycle is there?
In case it's relevant, the following code would be used to set the 'password-to-open':
[workbook].Protect = pass

VB excel worksheet not copying to new workbook

struggling to copy a worksheet from source book to destination book.
I've tried 4 different codes found on SO, but running into different errors all the time.
Either: "Copy method failed", "No such interface found", "Exception"- at the copy function.
I know that there are a lot of links and websites referring to the copy method, but i've tried them all and still no luck.
Option Strict = Off
Option Explicit = On
Excel 2016
VS 2019
Sourceworkbook has formatting in and merged cells. Needing the formatting included in the copy method, because I'll be using the new workbooks as back-ups or copies for printing. The sourceworkbook has a template on one of the sheets named "TempPage".
Code:
xlApp1 = New Excel.Application
xlWorkBook1 = xlApp1.Workbooks.Add
'xlWorkSheet1 = CType(xlWorkBook1.Sheets.Add(), Excel.Worksheet)
xlWorkSheet = CType(xlWorkBook.Sheets("TempPage"), Excel.Worksheet) 'Source
xlWorkSheet1 = CType(xlWorkBook1.Sheets("Sheet1"), Excel.Worksheet) 'Destination
'Tried this code
'Dim rngSource As Excel.Range, rngTarget As Excel.Range, targetRow As Long
'rngSource = xlWorkBook.Sheets("TempPage").UsedRange
'With xlWorkBook.Sheets("TempPage")
'targetRow = .UsedRange.SpecialCells(XlCellType.xlCellTypeLastCell).Row + 1
'rngTarget = .cells(targetRow, rngSource.Column)
'End With
'rngSource.Copy(rngTarget)
'Tried this code
'Dim sourceWorkSheet As Excel.Worksheet
'sourceWorkSheet = xlWorkBook.Sheets("TempPage")
'//Copies the source worksheet to the destination workbook, places it after the last
'//sheet in the destination workbook.
'sourceWorkSheet.Copy(, xlWorkBook1.Sheets(xlWorkBook1.Sheets.Count))
'Tried this
'xlWorkSheet.Copy(, xlWorkBook1.Sheets(xlWorkBook1.Sheets.Count))
'tried this
'xlWorkSheet1.Range("A1:I46").Value = xlWorkSheet.Range("A1:I46").Value
'xlWorkSheet.Application.Goto(xlWorkSheet.Range("A1:I46"), True)
'xlWorkSheet.Range("A1:I46").Select()
'xlWorkSheet.Range("A1:I46").Copy()
'xlWorkSheet1.PasteSpecial(Excel.XlPasteType.xlPasteAll,
'Excel.XlPasteSpecialOperation.xlPasteSpecialOperationNone, False, False)
'Tried this
'xlWorkSheet.Range("A1:I46").Copy(xlWorkSheet1.Range("A1:I46"))
'xlWorkSheet1.PasteSpecial(Excel.XlPasteType.xlPasteFormats)
xlWorkBook1.SaveAs(BTPath & "\" & xlWorkSheet.Range("B3").Value & ".xls", Excel.XlFileFormat.xlExcel5) 'save the receipt as the ticket number
If RadioButton3.Checked = True Then
'unpaid - send copy to unpaid folder
xlWorkBook1.SaveAs(UnpaidPath & "\" & xlWorkSheet.Range("B3").Value & ".xls", Excel.XlFileFormat.xlExcel5)
ElseIf RadioButton4.Checked = True Then
End If
I need help with the copying method please.
After a bit more research, found a way to save the worksheet from the source book. Closing the book and reopening the source book for continued usage. Only problem i'm now running into, is that the formulas are still being copied as well and some cells aren't in the same format(bold, merged, size) but found a link on SO - Save values (not formulae) from a sheet to a new workbook?
New code:
'save first
xlWorkBook.Save() 'Save the workbook
Dim newpath As String = BTPath & "\" & xlWorkSheet.Range("B3").Value & ".xls"
xlWorkSheet = CType(xlWorkBook.Sheets("TempPage"), Excel.Worksheet)
xlWorkSheet.Copy()
xlWorkSheet.SaveAs(newpath, Excel.XlFileFormat.xlExcel5)
If RadioButton3.Checked = True Then
'unpaid - send copy to unpaid folder
xlWorkBook.SaveAs(BTPath & "\" & xlWorkSheet.Range("B3").Value & ".xls")
End If
'Close the file and reopen the database file
xlWorkBook.Save() 'Save the workbook
xlWorkBook.Close() 'Close workbook
If xlApp Is Nothing Then
'do nothing
Else
xlApp.Quit() 'Quit the application
End If
GC.Collect()
GC.WaitForPendingFinalizers()
System.Threading.Thread.Sleep(500)
GC.Collect()
GC.WaitForPendingFinalizers()
System.Threading.Thread.Sleep(500)
'reopen
xlApp = New Excel.Application
xlWorkBook = xlApp.Workbooks.Open(filepath)
'clear the sheet
xlWorkSheet = CType(xlWorkBook.Sheets("TempPage"), Excel.Worksheet)
xlWorkSheet.Range("D45").Value = ""
xlWorkSheet.Range("B3").Value = ""
xlWorkSheet.Range("B10").Value = ""
xlWorkSheet.Range("F10").Value = ""
xlWorkSheet.Range("F12").Value = ""
xlWorkSheet.Range("B11").Value = ""
xlWorkSheet.Range("F11").Value = ""
xlWorkSheet.Range("I10").Value = ""
xlWorkSheet.Range("A14:H10").Value = ""
'save but don't close
xlWorkBook.Save() 'Save the workbook

create multiple workbooks in certain folder location

Lets say I want to create 5 workbooks in certain location. I was trying to use this code but it doesn't work. (run-time error, automation error), what is wrong with it?
Sub blabal()
Dim wbk As Workbook
Dim i As Integer
i = 1
Set wbk = Workbook.Add
Do Until i = 5
wbk.SaveAs "C:\Users\User1\Desktop\abc\" & i
wbk.Close
i = i + 1
Loop
End Sub
Set wbk = Workbooks.Add
You need to specify Workbooks instead of Workbook.
Workbooks is a collection object. You're adding a Workbook to the collection of Workbooks.
You also need to change the order of your code, so you're either not closing the workbook each time, or so that you are closing the workbook, but you're then adding a new workbook (which doesn't really make much sense, but I'll show an example anyway).
Set wbk = Workbooks.Add
Do Until i = 5
wbk.SaveAs "C:\Users\User1\Desktop\abc\" & i
i = i + 1
Loop
Or
Do Until i = 5
Set wbk = Workbooks.Add
wbk.SaveAs "F:\" & i
wbk.Close
i = i + 1
Loop

Refresh values from external sheet on background

I have two sheets, where I need to refresh values (function VLOOKUP) from source.xlsm to update.xlsm ON BACKGROUND by VBA (only manual refresh by button with assigned macro - I do not want to use update button in Excel options).
I have found two codes, which complete this task, however, the source.xlsm always pops up for a second while the task is made. I would like to have the task completed without the source file being visible on the screen.
Any ideas?
Sub Read_External_Sheet()
'''''Define Object for Target Workbook
Dim Target_Workbook As Workbook
Dim Source_Workbook As Workbook
Dim Target_Path As String
'''''Assign the Workbook File Name along with its Path
'''''Change path of the Target File name
Target_Path = "D:\Source.xlsm"
Set Target_Workbook = Workbooks.Open(Target_Path)
Set Source_Workbook = ThisWorkbook
'''''With Target_Workbook object now, it is possible to pull any data from it
'''''Read Data from Target File
Target_Data = Target_Workbook.Sheets(1).Cells(1, 1)
DoEvents
Source_Workbook.Sheets(1).Cells(1, 1) = Target_Data
DoEvents
'''''Update Target File
Source_data = Source_Workbook.Sheets(1).Cells(3, 1)
DoEvents
Target_Workbook.Sheets(1).Cells(2, 1) = Source_data
DoEvents
'''''Close Target Workbook
Target_Workbook.Close False
'''''Process Completed
MsgBox "SHEET UPDATED"
End Sub
Sub Read_External_Sheet_2()
Dim FName As Workbook
With Application
.EnableEvents = False
Set FName = .Workbooks.Open("D:\Source.xlsm", False)
mybook = FName.Name
With FName
.RefreshAll
.Close True 'save file
End With
.EnableEvents = True
End With
msg = MsgBox(mybook & " Refreshed")
End Sub

Copying data from multiple pdf files

I have pdf files from which I would like to copy all the data to a column in a spreadsheet.
Here is the code I have. All it does is open the pdf, use control-a, then control-c to copy then activates the workbook, finds an open column and pastes the data with a control-v Sendkey.
I have a range with path names it opens and copies data from all but only pastes the last one.
Sub StartAdobe1()
Dim AdobeApp As String
Dim AdobeFile As String
Dim StartAdobe
Dim fname As Variant
Dim iRow As Integer
Dim Filename As String
For Each fname In Range("path")
AdobeApp = "C:\Program Files (x86)\Adobe\Reader 10.0\Reader\AcroRd32.exe"
StartAdobe = Shell("" & AdobeApp & " " & fname & "", 1)
Application.Wait Now + TimeValue("00:00:01")
SendKeys "^a", True
Application.Wait Now + TimeValue("00:00:01")
SendKeys "^c"
Application.Wait Now + TimeValue("00:00:01")
SendKeys ("%{F4}")
Windows("transfer (Autosaved).xlsm").Activate
Worksheets("new").Activate
ActiveSheet.Range("A1").Select
Selection.End(xlToRight).Offset(0, 1).Select
SendKeys "^v"
Application.Wait Now + TimeValue("00:00:2")
Next fname
Jeanno's right, if you have Acrobat then using its API library to work with the file directly is much better than the workarounds. I use this every day to convert pdf files into database entries.
Your code has a few problems, but I suspect the biggest issue is the use of SendKeys "^v" to paste into Excel. You're better off selecting the cell you want then using Selection.Paste. Or even better, transfer the contents of the clipboard to a variable, then parse it out as needed on the backend before writing to your spreadsheet--but that adds a bunch of complexity and doesn't help you a lot in this case.
To use the code below, be sure to select your 'Acrobat x.x Type Library' under Tools>References.
Sub StartAdobe1()
Dim fName As Variant
Dim wbTransfer As Excel.Workbook
Dim wsNew As Excel.Worksheet
Dim dOpenCol As Double
Dim oPDFApp As AcroApp
Dim oAVDoc As AcroAVDoc
Dim oPDDoc As AcroPDDoc
'Define your spreadsheet
Set wbTransfer = Workbooks("transfer (Autosaved).xlsm")
Set wsNew = wbTransfer.Sheets("new")
'Find first open column
dOpenCol = ws.Cells(1, columns.count).End(xlToleft).Column + 1
'Instantiate Acrobat Objects
Set oPDFApp = CreateObject("AcroExch.App")
Set oAVDoc = CreateObject("AcroExch.AVDoc")
Set oPDDoc = CreateObject("AcroExch.PDDoc")
For Each fName In Range("path")
'Open the PDF file. The AcroAVDoc.Open function returns a true/false
'to tell you if it worked
If oAVDoc.Open(fName.Text, "") = True Then
Set oPDDoc = oAVDoc.GetPDDoc
Else
Debug.Assert False
End If
'Copy all using Acrobat menu
oPDFApp.MenuItemExecute ("SelectAll")
oPDFApp.MenuItemExecute ("Copy")
'Paste into open column
wbTransfer.Activate
wsNew.Cells(1, dOpenCol).Select
ActiveSheet.Paste
'Select next open column
dOpenCol = dOpenCol + 1
oAVDoc.Close (1) '(1)=Do not save changes
oPDDoc.Close
Next
'Clean up
Set wbTransfer = Nothing
Set wsNew = Nothing
Set oPDFApp = Nothing
Set oAVDoc = Nothing
Set oPDDoc = Nothing
End Sub
Note:
1-There is also a menu item oPDFApp.MenuItemExecute ("CopyFileToClipboard") that should do the select all and copy in one step, but I have had problems with it so I stick to the two-step method above.
2-A pdf file consists of two objects, the oAVDoc and the oPDDoc. Different aspects of the file are controlled by each. In this case you might only need the oAVDoc. Try commenting out the lines dealing with oPDDoc and see if it works without them.
I can't quite get your code to work, but my guess is that it's copying all of the data, but overwriting it each time through the loop. To fix this try:
ActiveSheet.Cells(1, ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column + 1).Select
instead of the two lines that begin activesheet.range("A1").Select and Selection.End....
try this code this might work:
Sub Shell_Copy_Paste()
Dim o As Variant
Dim wkSheet As Worksheet
Set wkSheet = ActiveSheet
o = Shell("C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe C:\Users\saurabh.ad.sharma\Desktop\red.pdf", vbNormalFocus)
Application.Wait (Now + TimeSerial(0, 0, 2)) 'Wait for Acrobat to load
SendKeys "^a" 'Select All
SendKeys "^c" 'Copy
SendKeys "%{F4}" 'Close shell application
wkSheet.Range("B5").Select
SendKeys "^v" 'Paste
End Sub
BELOW CODE WILL COPY DATA FROM PDF & will PASTE IT IN WORD THEN COPY DATA FROM WORD AND THEN PASTE IT TO THE EXCEL .
NOW Why I am copying data from pdf to word & then copying from word and pasting it to the excel because i want the data from the pdf in exact format to my excel sheet if i copy directly from pdf to excel it will paste the whole data from pdf into a single cell means even if i am having two columns or multiple rows it will paste all of my data into one column and that too in single cell but if i copy from word to excel it will retain its original format and two columns will get pasted as two columns only in excel.
Private Sub CommandButton3_Click() '(load pdf)
Dim o As Variant
Set appWord = CreateObject("Word.Application")
o = Shell("C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe C:\Users\saurabh.ad.sharma\Desktop\Book1.pdf", vbNormalFocus) 'loading adobe reader & pdf file from their location
Application.Wait (Now + TimeSerial(0, 0, 2))
SendKeys ("^a")
SendKeys ("^c")
SendKeys "%{F4}"
Application.Wait Now + TimeValue("00:00:01")
Set appWord = CreateObject("Word.Application")
appWord.Visible = True
appWord.Documents.Add.Content.Paste
With appWord
.ActiveDocument.SaveAs Filename:=ThisWorkbook.Path & "\pdf" & ".docx", FileFormat:=wdocument 'saving word file in docx format
.ActiveWindow.Close
.Quit
End With
MsgBox " pdf is loaded "
MsgBox " Paste to EXCEL "
Set appWord = CreateObject("Word.Application")
appWord.Visible = True
appWord.Documents.Open "C:\Users\saurabh.ad.sharma\Desktop\pdf.docx" 'opening word document
appWord.Selection.WholeStory
appWord.Selection.Copy
Set wkSheet = ActiveSheet
wkSheet.Range("A1").Select
wkSheet.Paste 'pasting to the excel file
End Sub
This is the more modified version of my above code it will not save any document it will save data in clipboard and will do the execution fast..
Private Sub CommandButton3_Click() '(load pdf)
Dim o As Variant
Set appWord = CreateObject("Word.Application")
o = Shell("C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe C:\Users\saurabh.ad.sharma\Desktop\Book1.pdf2", vbNormalFocus)
Application.Wait (Now + TimeSerial(0, 0, 2))
SendKeys ("^a")
SendKeys ("^c")
SendKeys "%{F4}"
Application.Wait Now + TimeValue("00:00:01")
Set appWord = CreateObject("Word.Application")
appWord.Visible = False
appWord.Documents.Add.Content.Paste
With appWord
.Selection.WholeStory
.Selection.Copy
.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
.Quit
End With
MsgBox " pdf is loaded "
MsgBox " Paste to EXCEL "
Set wkSheet = ActiveSheet
wkSheet.Range("A1").Select
wkSheet.Paste
End Sub
I had similar problem. The best solution is, as it was mentioned before, to use Adobe API. In my case it was impossible because macro was intended for 100+ users without Adobe Pro on their PC.
Ultimate solution that I have developed recently was to build converted in C# (for free using Visual Studio and iText library), install it on end users computers and run whenever I need via VBA. Here are some links for more guidance:
How to develop pdf converter in C#: link
How to create Excel Addin in C#: link
How to run C# addin from VBA: link
Overall it's fairly complicated but once done works like a dream.
Another solution as mentioned before is to use sendkeys in VBA. My experience is that it requires some optimization to handle various opening and copying times (depending on file size). Below is code that worked for me, however it's not even near that fast and stable as C# converter.
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr) 'Initialize sleep function via Windows API
Public Sub CopyToSheet(destinationSheet As Worksheet, pathToPdf as String)
'Copy data from PDF to worksheet
'Initialize timer
Dim StartTime As Double
StartTime = Timer
'Clear clipboard
Dim myData As DataObject
Set myData = New DataObject
myData.SetText text:=Empty
myData.PutInClipboard
Set myData = Nothing
'Build file paths
Dim pathToAdobe As String
pathToAdobe = """C:\Program Files (x86)\Adobe\Acrobat Reader DC\Reader\AcroRd32.exe"""
pathToPdf = """" & pathToPdf & """"
'Open PDF and wait untill it is open. If file is already opened it will be just activated
Dim pdfId As Long
pdfId = Shell(pathToAdobe & " " & pathToPdf, vbMaximizedFocus)
Do
Sleep (500)
If Round(Timer - StartTime, 2) > 9 Then MsgBox "Failed to open PDF": Exit Sub 'Safety check
Loop Until Me.IsPdfOpen(pathToPdf)
'Copy and wait until copying is completed
SendKeys "^a"
SendKeys "^c"
Do
Sleep (500)
If Round(Timer - StartTime, 2) > 18 Then MsgBox "Failed to copy data to clipboard": Exit Sub 'Safety check
Loop Until Me.GetClipboardStatus = "ClipboardHasData"
'Paste data into worksheet
destinationSheet.Activate
destinationSheet.Range("A1").Select
destinationSheet.Paste
'Close pdf
Call Shell("TaskKill /F /PID " & CStr(pdfId), vbHide)
'Clear clipboard
Set myData = New DataObject
myData.SetText text:=Empty
myData.PutInClipboard
Set myData = Nothing
End Sub
Function IsPdfOpen(pathToPdf) As Boolean
'Check if PDF is already opened
'Build window name (window name is name of the application on Windows task bar)
Dim windowName As String
windowName = pathToPdf
windowName = Mid(windowName, InStrRev(windowName, "\") + 1, Len(windowName) - InStrRev(windowName, "\") + 1)
windowName = windowName + " - Adobe Acrobat Reader DC"
'Try to activate application to check if is opened
On Error Resume Next
AppActivate windowName, True
Select Case Err.Number
Case 5: IsPdfOpen = False
Case 0: IsPdfOpen = True
Case Else: Debug.Assert False
End Select
On Error GoTo 0
End Function
Function GetClipboardStatus() As String
'Check if copying data to clipboard is completed
Dim tempString As String
Dim myData As DataObject
'Try to put data from clipboard to string to check if operations on clipboard are completed
On Error Resume Next
Set myData = New DataObject
myData.GetFromClipboard
tempString = myData.GetText(1)
If Err.Number = 0 Then
If tempString = "" Then
GetClipboardStatus = "ClipboardEmpty"
Else
GetClipboardStatus = "ClipboardHasData"
End If
Else
GetClipboardStatus = "ClipboardBusy"
End If
On Error GoTo 0
Set myData = Nothing
End Function

Resources