How do you search for the last empty cell in an excel sheet from a vsto outlook addin?
I have the following code (not compiling)
Imports Excel = Microsoft.Office.Interop.Excel
Dim ExcelApp As New Excel.Application
Dim ExcelWorkbook As Excel.Workbook
Dim ExcelWorkSheet As Excel.Worksheet= ExcelWorkbook.Worksheets(1)
Dim ExcelRange As Excel.Range = ExcelWorkSheet.Range("A1","A600")
Dim currentFind As Excel.Range = Nothing
Dim firstFind As Excel.Range = Nothing
currentFind = ExcelRange.Find("*", , Excel.XlFindLookIn.xlValues, Excel.XlLookAt.xlPart, Excel.XlSearchOrder.xlByRows, Excel.XlSearchDirection.xlNext, False)
While Not currentFind Is Nothing
' Keep track of the first range you find.
If firstFind Is Nothing Then
firstFind = currentFind
' If you didn't move to a new range, you are done.
ElseIf currentFind.Address = firstFind.Address Then
Exit While
End If
currentFind = ExcelRange.FindNext(currentFind)
End While
ExcelWorkbook.ActiveSheet.range(currentFind).Select()
I have updated it according to Scott Holtzman's comments but now I get an error message: HRESULT: 0x800A03EC
The code does not have the correct hierarchy according to the Object Model.
You cannot define a Range object without first defining a Worksheet object, which needs a Workbook object before it can be defined.
Try this:
Set ExcelApp = New Excel.Application
Dim ExcelWorkbook as Excel.Workbook
Set ExcelWorkbook = ExcelApp.Workbooks.Open("myPath") 'actually opens a workbook to work with
Dim ExcelWorksheet as Excel.Worksheet
Set ExcelWorksheet = ExcelWorkbook.Worksheets("mySheet")
Dim currentFind As Excel.Range = Nothing
Dim firstFind As Excel.Range = Nothing
Dim Fruits As Excel.Range = ExcelWorksheet.Range("A1", "A200")
Set currentFind = Fruits.Find("apples", , Excel.XlFindLookIn.xlValues, Excel.XlLookAt.xlPart, Excel.XlSearchOrder.xlByRows, Excel.XlSearchDirection.xlNext, False)
...
Set currentFind = Fruits.FindNext(currentFind)
SOLVED: I have the following code (now compiling!)
Imports Excel = Microsoft.Office.Interop.Excel
Dim ExcelApp As New Excel.Application
Dim ExcelWorkbook As Excel.Workbook
Dim ExcelWorkSheet As Excel.Worksheet= ExcelWorkbook.Worksheets(1)
Dim LastRow As Integer
LastRow = ExcelWorkSheet.Columns(1).Find("*", , , , Excel.XlSearchOrder.xlByColumns, Excel.XlSearchDirection.xlPrevious).Row
ExcelWorkSheet.Range("A" & LastRow).Select()
My error was in the actual property library choice. Beware to choose:
XlSearchOrder.xlByColumns, Excel.XlSearchDirection.xlPrevious
Related
We have switched over to office 365 / outlook.
we have a legacy application in VB6 the was working fine with the previous version of outlook. but now we are having issues with an automated email with in VB6, that sends daily reports. Can someone tell me what is the equivalent of the following code is and what reference i need to point to?`
Dim mstrEmailTo As String 'email to addresses
Dim mstrEmailCC As String 'email cc addresses
mstrEmailTo = Text1.Text
mstrEmailCC = "TestEmail"
Dim oApp As Outlook.Application
Dim oCB As Office.CommandBar
Dim oCBTools As Office.CommandBarPopup
Dim oCBSelect As Office.CommandBarButton
Dim oInsp As Outlook.Inspector
Dim oCont As Outlook.MailItem
Set oApp = New Outlook.Application
Dim oInspLeft As Integer
Dim oContTo As String
Dim oContCC As String
Set oCont = oApp.CreateItem(olMailItem)
If mstrEmailTo <> "" Then
'objRecipients.AddMultiple mstrEmailTo, CdoTo
oCont.To = mstrEmailTo
End If
If mstrEmailCC <> "" Then
'objRecipients.AddMultiple mstrEmailCC, CdoCc
oCont.CC = mstrEmailCC
End If
'Set objNewMsg.Recipients = mobjSession.AddressBook(objRecipients, "Select recipients for the Daily report ...", , True, 2)
Set oInsp = oCont.GetInspector
oInsp.Display vbModeless
oInsp.WindowState = olNormalWindow
oInspLeft = oInsp.Left
oInsp.Left = -10000 'Set the Inspector off screen.
'Set to 250 to return it to viewable location
Set oCB = oInsp.CommandBars("Menu Bar")
Set oCBTools = oCB.Controls("&Tools")
Set oCBSelect = oCBTools.Controls("Address &Book...")
oCBSelect.Execute
oContTo = oCont.To
oContCC = oCont.CC
oCont.Close olDiscard
oInsp.Left = oInspLeft
Set oCont = Nothing
Set oCBSelect = Nothing
Set oCBTools = Nothing
Set oCB = Nothing
Set oApp = Nothing`
You don't need to simulate a button click to show an address book. You need to use SelectNamesDialog object for that - see https://learn.microsoft.com/en-us/office/vba/api/outlook.selectnamesdialog
I have a function that can get the page's number of the pdf file.
Public Function GetNumPages(ByVal PdfFile As String) As Long
Dim objTempDoc As Object
Dim fso As FileSystemObject
Set fso = New FileSystemObject
If fso.FileExists(PdfFile ) Then
Set objTemp = CreateObject("AcroExch.PDDoc")
objTemp.Open pstrPdfFilename
GetNumPages = objTemp.GetNumPages
objTemp.Close
Set objTemp = Nothing
End If
Set fso = Nothing
End Function
I want to get the last line's context in last page of pdf file.
I have found this API, but I don't know how to use it.
Will it return the context that I want?
PDOCContext PDDocGetOCContext(PDDoc pdDoc)
I tried this way to use API, but it was fail.
Set objTempDoc = CreateObject("AcroExch.PDDoc")
objTempDoc.Open PdfFile
myPDFPage = objTempDoc.GetOCContext
Can call this Function to get the text of last page.
Public Function GetPDFText(ByVal pstrPdfFilename As String) As String
Dim PDDoc As Object
Dim CAcroRect As New Acrobat.AcroRect
Dim PDPage As Acrobat.AcroPDPage
Dim PDTxtSelect As Acrobat.AcroPDTextSelect
Dim CArcoPoint As Acrobat.AcroPoint
Dim iNumWords As Integer
Dim iMax As Long
Dim arPdfLines() As String
Dim i As Integer
Dim fso As FileSystemObject
Set fso = New FileSystemObject
If fso.FileExists(pstrPdfFilename) Then
Set PDDoc = CreateObject("AcroExch.PDDoc")
PDDoc.Open pstrPdfFilename
Set PDPage = PDDoc.AcquirePage(PDDoc.GetNumPages() - 1)
Set CArcoPoint = PDPage.GetSize()
CAcroRect.Top = CArcoPoint.y
CAcroRect.Left = 0
CAcroRect.Right = CArcoPoint.x
CAcroRect.bottom = 0
Set PDTxtSelect = PDDoc.CreateTextSelect(PDDoc.GetNumPages() - 1, CAcroRect)
If PDTxtSelect Is Nothing Then
iNumWords = 0
iMax = 0
GetPDFLastLineText = ""
Else
iNumWords = PDTxtSelect.GetNumText
iMax = iNumWords - 1
Dim ii As Long
For ii = 0 To iMax
GetPDFLastLineText = GetPDFLastLineText & PDTxtSelect.GetText(ii)
Next
End If
PDDoc.Close
End If
Set fso = Nothing
Set PDDoc = Nothing
Set CAcroRect = Nothing
Set PDPage = Nothing
Set PDTxtSelect = Nothing
Set CArcoPoint = Nothing
End Function
I am trying to display an image from a SpreadSheet(OpenOffice) into my PictureBox control and here is my code.
Dim objServiceManager As Object
Dim objDesktop As Object
Dim objDocument As Object
Dim objText As Object
Dim objCursor As Object
Dim oDoc As Object
Dim ARG()
Dim oGraph As Object
Dim oView As Object
Dim oDrawPage As Object
Dim oSheet As Object
Dim oimage As Object
Dim osize As Object
Dim Cell As Object
Dim GraphURL As String
Set objServiceManager = CreateObject("com.sun.star.ServiceManager")
Set objDesktop = objServiceManager.createInstance("com.sun.star.frame.Desktop")
Set osize = objServiceManager.Bridge_GetStruct("com.sun.star.awt.Size")
Set opos = objServiceManager.Bridge_GetStruct("com.sun.star.awt.Point")
Set oDoc = objDesktop.loadComponentFromURL("file:///C:\Users\paul\Desktop\ACE Express - Fairview_Sample PC of Gondola.ods", "_blank", 0, ARG())
Set oSheet = oDoc.getSheets().getByIndex(0)
Set oimage = oDoc.createInstance("com.sun.star.drawing.GraphicObjectShape")
Set oView = oDoc.CurrentController
Set oDrawPage = oView.getActiveSheet.DrawPage
Set oControl = oDoc
Set oDrawPage = oDoc.getDrawPages().getByIndex(0)
Set oimage = oDrawPage.getByIndex(0)
Image1.Picture = LoadPicture(oimage.GraphicURL)
But sad to say I have this error
It is supposed to be that the image that will replace the image in my picturebox(Mountain.jpg) is this.
But it doesn't happen
Please take note of the following:
The spreadsheet used is OpenOffice Calc
Displaying the image inside Picturebox (VB6)
Update 2
The error comes from the code.
Image1.Picture = LoadPicture(oimage.GraphicURL)
Can anyone tell me why the activeworksheet object MCWS is not being created by the following VB Script please? It is the code for a combobox in a mathcad worksheet. Thanks
Public Sub SizeBoxEvent_Start()
Dim objEX
Dim objMC
Dim MCWS
Dim objEXWB
Dim objEXWS
Dim intLineNo
Dim objRange
End Sub
Sub SizeBoxEvent_Exec(Inputs,Outputs)
Set objMC = CreateObject("MathCad.Application")
Set MCWS = objMC.ActiveWorkSheet
Set objEX = CreateObject("Excel.Application")
Set objEXWB = GetObject("C:\UB_Dims.xls")
Set objEXWS = objEXWB.worksheets("UB")
Dim MyList(71)
For i = 0 to 71
Mylist(i) = CStr(objEXWS.cells(i+3,1))
'MsgBox Mylist(i)
Next
SizeBox.List() = MyList
intLineNo = SizeBox.ListIndex + 3
objRange = "A" & intLineNo & ":U" & intLineNo
Dim varDimProps(21)
Dim varDimName(21)
For i = 1 to 21
varDimProps(i) = objEXWS.cells(intLineNo,i)
varDimName(i) = CStr(objEXWS.cells(1,i))
Next
MCWS.SetValue "Size", ABC
MCWS.SetValue "M", 288
MCWS.SetValue "D", 203
Outputs(0).Value = varDimProps
End Sub
Sub SizeBoxEvent_Stop()
Rem TODO: Add your code here
End Sub
I haven't used Public subs, so I don't know if your declarations will carry over to other subs. Here's something I picked from the PTC forum that works in Excel 2007 with Mathcad 15.0 (I understand that the excel add in is broken for later excel versions).
My guess is that you should define your objects in the functions that use them. Also, I don't think you can use Activeworksheet for the MathCad worksheet.
Private Function RunMCAD(InputFile As String)
Dim MC As Object
Set MC = CreateObject("Mathcad.Application")
MC.Visible = True
Set Wk = MC.Worksheets
Set WS = Wk.Open("C:\RDDA\RDDA 2014-10-16_excel.xmcd")
WS.SetValue "InputFile", InputFile
WS.Recalculate
WS.Save
WS.Close False
MC.Quit
RunMCAD = "Done"
End Function
Using VB6, is it possible to get a list of all available domains in active directory?
Thanks,
Alex
Add references for ActiveDS type library, and ADO to your project.
Sub GetDomains()
Dim objRootDSE As IADs
Dim objBase As IADs
Dim path As String
Dim rsDomains As ADODB.Recordset
Dim cnADS As ADODB.Connection
Dim cmdCommand As ADODB.Command
Set objRootDSE = GetObject("LDAP://rootDSE")
path = "LDAP://" & objRootDSE.Get("rootDomainNamingContext")
Set objBase = GetObject(path)
Set cnADS = New ADODB.Connection
cnADS.Provider = "ADsDSOObject"
cnADS.Open "ADSI"
Set cmdCommand = New ADODB.Command
cmdCommand.ActiveConnection = cnADS
cmdCommand.Properties("searchScope") = ADS_SCOPE_SUBTREE
cmdCommand.CommandText = "SELECT Name, distinguishedName FROM '" & objBase.ADsPath & "' WHERE objectCategory = 'domain'"
Set rsDomains = cmdCommand.Execute
Do While rsDomains.EOF = False
List1.AddItem (rsDomains!Name)
rsDomains.MoveNext
Loop
End Sub
I have only the one domain to test this against so I hope you'll need to let me know if it gets all the domains for you. Also please note, I didn't add error handling.