Visio button to compare text in excel file; error 438 - vba

I am trying to make a visio diagram that you click a button and it searchs and excel file for the "location" once it find the location in the excel file it then copies over a URL and proceeds to open that URL with the default browser. I keep getting runtime error 438: Object doesn't support this property or method. Any ideas?
Option Compare Text
Private Sub Mail_Room_Click()
Dim XLApp As Excel.Application
Dim XLWB As Excel.Workbook
Set XLApp = New Excel.Application
Set XLWB = XLApp.Workbook.Open("C:\printers\schprint.xlsx")
Set XLWsht = XLWB.Sheets(1)
Dim URL As String
Dim Location As String
Location = "Mail Room"
URL = ""
For Each i In XLWsht.Range("D2:D11")
If StrComp(i.Cells.Value, Location) = 0 Then
URL = i.Cells.Offset(7, 0).Value
Exit For
End If
Next i
CreateObject("WScript.Shell").Run (URL)
End Sub

I think you're just missing as 's' in XLApp.WorkbookS.Open("C:\printers\schprint.xlsx")
That should fix the problem.

Related

Use an existing Excel file to save data on and save under a new name

I am creating a program that takes an Excel file, stamps information on it and saves it in a file location.
I can easily create a new Excel sheet, put information on it and then save it to a file location. That is not what I need though. In the form, I want it to pull the existing blank Excel file template I have created, stamp the information entered in the form to it, rename the file and save it in a file location (similar to "save as"). That way there will be one blank master template file to get initially.
I cannot figure out how to grab that Excel file and not create a new Excel file.
Here is some sample code:
If EmployeeInfo.empNameTextBox.Text = "" Or EmployeeInfo.dateBox.Text = "" Then
'prompt user must include name and date at least to save
MessageBox.Show("In order to save a file, you must include the name AND the date", "Fill in Name/Date!",
MessageBoxButtons.OK, MessageBoxIcon.Error)
'minimize the password form and open back up the EmployeeInfo form
EmployeeInfo.Show()
Me.Hide()
Else
'create and save the excel file
Dim oExcel As Object
Dim oBook As Object
Dim oSheet As Object
'Start a new workbook in Excel
oExcel = CreateObject("Excel.Application")
oBook = oExcel.Workbooks.Add
'Add data to cells of the first worksheet in the new workbook
oSheet = oBook.Worksheets(1)
oSheet.Range("A1").Value = "Last Name"
oSheet.Range("B1").Value = "First Name"
oSheet.Range("A1:B1").Font.Bold = True
oSheet.Range("A2").Value = "Litoris"
oSheet.Range("B2").Value = "Mike"
'Save the Workbook and Quit Excel
oBook.SaveAs("N:\IT\Device Images\Incomplete\" + EmployeeInfo.empNameTextBox.Text + EmployeeInfo.dateBox.Text)
oExcel.Quit
'minimize this form and go back to main form
ImageTool.Show()
Me.Hide()
End If
To confirm, I do not want to start a new Excel workbook and cannot figure out how to pull my existing file I created.
Just change oBook = oExcel.Workbooks.Add to oBook = oExcel.Workbooks.Open("C:\Path\FileName.xls")
And set the right path, as well as the right sheet on the next line! ;)
If EmployeeInfo.empNameTextBox.Text = "" Or EmployeeInfo.dateBox.Text = "" Then
'prompt user must include name and date at least to save
MessageBox.Show("In order to save a file, you must include the name AND the date", "Fill in Name/Date!",
MessageBoxButtons.OK, MessageBoxIcon.Error)
'minimize the password form and open back up the EmployeeInfo form
EmployeeInfo.Show()
Me.Hide()
Else
'create and save the excel file
Dim oExcel As Object
Dim oBook As Object
Dim oSheet As Object
'Start a new workbook in Excel
oExcel = CreateObject("Excel.Application")
oBook = oExcel.Workbooks.Open("C:\Path\FileName.xls")
'Add data to cells of the first worksheet in the new workbook
oSheet = oBook.Worksheets(1)
oSheet.Range("A1").Value = "Last Name"
oSheet.Range("B1").Value = "First Name"
oSheet.Range("A1:B1").Font.Bold = True
oSheet.Range("A2").Value = "Litoris"
oSheet.Range("B2").Value = "Mike"
'Save the Workbook and Quit Excel
oBook.SaveAs("N:\IT\Device Images\Incomplete\" + EmployeeInfo.empNameTextBox.Text + EmployeeInfo.dateBox.Text)
oExcel.Quit
'minimize this form and go back to main form
ImageTool.Show()
Me.Hide()
End If
As already stated in R3uK's answer you can use the Workbooks.Open method:
Dim oExcel As Object
Dim oBook As Object
oExcel = CreateObject("Excel.Application")
oBook = oExcel.Workbooks.Open("filename")
I would like to expand on this ever so slightly and suggest that you reference the Excel objects directly:
Dim oExcel As New Excel.Application
Dim oBook As Workbook = oExcel.Workbooks.Open("filename")
This will help with referencing methods and properties on the Excel objects. Below you will see the difference:
Indirect Reference:
Direct Reference:
Note you must import the relevant Microsoft Excel Object Library into your project. You will also have to add Imports Microsoft.Office.Interop to your class.
As a side note, if you haven't already, I would strongly suggest turning Option Strict On whilst using the Excel objects:
Restricts implicit data type conversions to only widening conversions, disallows late binding, and disallows implicit typing that results in an Object type.

How Do I Use the Excel Function LoadPicture() from a Windows Form Application

I have a Windows Form application that my company uses to access all it's reports. Most of the reports are given to the user in an Excel sheet that is created at run-time either from scratch or an Excel Template. This has been working fine for everything up until now. The problem I am running into now is that I need to load an ImageBox on the Excel Template with an image saved on the drive. I have the filepath of the image (this will change each time this run). The only way I have found to be able to set the picture property of the ImageBox is like this...
Dim FileStr As String = "C:\Folder\ImageFile.jpg"
xlWorksheet.ImageName.Picture = LoadPicture(FileStr)
The problem is I can't figure out how to call the LoadPicture() function from within the windows form. I know I could create an Excel Module at run-time that call the LoadPicture() then delete it, but i just figured there had to be a better way? Hoping someone out there has suggestions. Thanks.
Edit:- Here is an example of the code I am Using to Open The Excel Sheet
Imports ExcelVB = Microsoft.Office.Interop.Excel
Imports ad = GartnerInterface.AdminClass.AdminTools
Imports xl = GartnerInterface.AdminClass.XlHelp
Public Class TestClass
Public Shared Sub NewSub()
Dim xlApp As ExcelVB.Application
Dim xlWorkbook As ExcelVB.Workbook
Dim xlWorksheet As ExcelVB.Worksheet
Dim TestSht As String
TestSht = "H:\Josh\ExcelTest.xlsm"
xlApp = CreateObject("Excel.Application")
xlWorkbook = xlApp.Workbooks.Add(TestSht)
xlApp.DisplayAlerts = False
xlApp.Visible = True
xlWorksheet = xlApp.Sheets("Sheet1")
Dim FileStr As String = "H:\12117\12117_Original.png"
'xlWorksheet.RFQImg.Picture = LoadPicture(FileStr)
End Sub
End Class
Now that I'm looking at the code, you would likely need the .AddPicture method
At the bottom of this code, you would need something like the following:
Dim FileStr As String = "H:\12117\12117_Original.png"
xlWorksheet.Shapes.AddPicture(FileStr, Microsoft.Office.Core.MsoTriState.msoFalse, Microsoft.Office.Core.MsoTriState.msoCTrue, 50, 50, 300, 45)
Taken from,
https://msdn.microsoft.com/en-us/library/office/ff198302.aspx
OR, if you have a template where the image is already named "test"
Dim FileStr As String = "H:\12117\12117_Original.png"
Dim imgName as String = "test"
For Each myShape In xlWorksheet.Shapes
If myShape.Name = imgName then
cTop = myShape.ShapeRange.Top 'we must save the values here
cLeft = myShape.ShapeRange.Left
cHeight = myShape.ShapeRange.Height
cWidth = myShape.ShapeRange.Width
myShape.delete
Exit For
end if
next
xlWorksheet.Shapes.AddPicture(FileStr, Microsoft.Office.Core.MsoTriState.msoFalse, Microsoft.Office.Core.MsoTriState.msoCTrue, cLeft, cTop, cWidth, cHeight)
An example, with user interaction, I borrowed from

Outlook VBA add hyperlink of chosen file in dialog

I'm trying to add the functionality in my Outlook (with VBA, I guess is easiest) to add a simple file dialog which takes the path of any files chosen and adds them to the email body as a hyperlink.
The idea of this is for network files to be shared amongst colleagues, instead of attaching them to the email, but just as easy to do.
This is my code so far, I can't even get the dialog to open, and I've had a good look at trying to get COMDLG32.ocx, so far I can't seem to make anything work.
Sub Main2()
Dim CDLG As Object
Set CDLG = CreateObject("MSComDlg.CommonDialog")
With CDLG
.DialogTitle = "Get me a File!"
.Filter = _
"Documents|*.doc|Templates|*.dot|Text Files|*.txt"
.ShowOpen
MsgBox .FileName
End With
Set CDLG = Nothing
End Sub
Thanks in advance, hopefully someone can show me how this is done!
Just for those who need it; OS Windows 10, Office 2010 H&B (yes, I know it's out of date :))
There seems to be no direct way to open a FileDialog in Outlook 2010 VBA.
The following macro (inspired by a related post) makes use of Excel to circumvent this:
Public Function promptFileName(title As String, filter As String) As String
' requires project reference to "Microsoft Excel 14.0 Object Library"
Dim xlObj As Excel.Application
Dim fd As Office.FileDialog
Dim name As String
Dim vItem As Variant
Dim filterArray() As String
Dim i As Integer
Set xlObj = New Excel.Application
xlObj.Visible = False
Set fd = xlObj.Application.FileDialog(msoFileDialogOpen)
name = ""
With fd
.title = title
.ButtonName = "Ok"
.Filters.Clear
filterArray = Split(filter, "|")
For i = LBound(filterArray) To UBound(filterArray) - 1 Step 2
.Filters.Add filterArray(i), filterArray(i + 1), 1 + i \ 2
Next i
If .Show = -1 Then
For Each vItem In .SelectedItems
name = vItem
Exit For
Next
End If
End With
xlObj.Quit
Set xlObj = Nothing
promptFileName = name
End Function
Private Sub testPromptFile
Dim name as String
name = promptFileName("a test", "Text Files (*.txt)|*.txt|All Files (*.*)|*.*")
MsgBox name
End Sub
Outlook 2013 and beyond provide an Office.FileDialog class for this purpose.
You can press a button with Outlook VBA.
Sub ExecuteMso_strId()
Dim objItem As Object
Dim strId As String
' Text appears when hovering over icon
' when adding buttons to a Quick Access toolbar or a ribbon
strId = "HyperlinkInsert"
On Error Resume Next
Set objItem = ActiveInspector.currentItem
On Error GoTo 0
If Not objItem Is Nothing Then
ActiveInspector.CommandBars.ExecuteMso (strId)
Else
ActiveExplorer.CommandBars.ExecuteMso (strId)
End If
End Sub
With this you do not have access to the parameters as with Excel.

MS Access 2010 - How can I tie an entry text box to a VBA command that opens a MS Word file based on user's entry?

Option Compare Database
Function Openword(conPath As String)
Dim appword As Word.Application
Dim doc As Word.Document
On Error Resume Next
Error.Clear
Set appword = GetObject(, "word.application")
If Err.Number <> 0 Then
Set appword = New Word.Application
appword.Visible = True
End If
Set doc = appword.Documents.Open(conPath, , True)
appword.Activate
Set doc = Nothing
Set appword = Nothing
End Function
Private Sub Command5_Click()
Dim mydoc As String
mydoc = "J:\3 - Client Services\1-Programs\12229709.docx"
Call Openword(mydoc)
End Sub
So far I have made the code that will open a specific file when the button on the form is clicked. However, there are a ton of these files that the user needs to be able to select and open. To keep it simple, I want them to be able to open the Word file by simply typing in the name of the file and clicking a button that will find and open it. The name of the file in the example above is simply 12229709.docx, but there are other files similar to it (e.g. 12172029, 12124057...) all in the same location. I want there to be a text box where the user can enter in the number and the button will check that specific folder for a file name with that number in it (without having to add the ".docx" if possible). How do I go about doing this?
EDIT - I forgot to mention that I cannot show the file path or use a file dialog box to allow the user to pick the file because the users that will be choosing the file do not have authorization to access this part of the network.
Try this out
Dim MyValue as Variant
MyValue = Inputbox("Enter File Name")
Dim MyDoc as String
MyDoc = "J:\3 - Client Services\1-Programs\" & MyValue & ".docx"
Call OpenWord(MyDoc)
Not sure if that is what you are looking for but I hope it helps.
I don't know why you'd want to make your user type in a file name when you can just open a file dialog and have them click on the right file.
Just put a command button on your form and include a line "Application.FollowHyperlink" plus this function name. The computer file associations can take care of the rest.
Sub Command()
Application.FollowHyperlink FileName()
End Sub
Public Function FileName() As String
Dim f As Object
' Must have object reference set to a MS Office Object Library for this to work.
Set f = Application.FileDialog(msoFileDialogFilePicker)
With f
.AllowMultiSelect = False
If .Show = -1 Then
FileName = .SelectedItems(1)
End If
End With
FileName = Nz(FileName, "")
End Function

Object Library not registered

I am using Access(2007) vba to process an Excel(ACCDB) workbook on a Sharepoint 2007 document library. In the process, I update two properties using the ExcelWB.ContentTypeProperties() proerty. It's been working fine literally for years. Today, it stopped working. It throws a "Object Library not registered" error. Research seems to suggest I've somehow gotten an old DLL for Excel registered, and the interface is using an old DLL that doesn't support the property.
My libraries are all found, no changes were made (by me...) in the last month to the machine. It's a client machine, so I can't speak for MS updates, etc. that were made. How can I fix this? It's literally got my client sitting on her hands, unable to work.
Dim xlApp As Excel.Application
Dim xlWB As Excel.WorkBook
Dim xlSH As Excel.Worksheet
Dim xlRA As Excel.Range
Dim bValidWorkbook As Boolean
Dim lngTrueHighestRow As Long
Dim strWorkbookName As String
WorkbookMessage , 3 'Clears the message queue
bValidWorkbook = True
strNewTimesheetStatus = "Rejected"
Set xlApp = New Excel.Application
xlApp.visible = False 'Don't let the workbook be shown
Set xlWB = xlApp.Workbooks.Open(URL) 'Open the workbook
lngCurrentVendorID = ParseVendor(strCurrentVendorName) 'Sets up the vendor recordset and the Labor rate Recordset. If it returns 0, it couldn't find the vendor
If lngCurrentVendorID = 0 Then
bValidWorkbook = False
WorkbookMessage "Workbook Rejected -- Vendor could not be validated"
GoTo ExitWorkbook
End If
'
' If the workbook is read-only, we can't proceed
'
If xlWB.ReadOnly Then
bValidWorkbook = False
WorkbookMessage "Workbook Rejected -- Workbook is read-only state"
GoTo ExitWorkbook
End If
Set xlSH = xlWB.Worksheets(1) 'Must be the first worksheet in the workbook
strWorkbookName = xlWB.NAME
Set xlRA = xlSH.UsedRange 'xlRA is the range of cells in the first workbook that are "USED"
strSheetArray = xlRA 'This sets an array of variants to the two dimensional range xlRA
xlRA.EntireRow.Hidden = False 'Unhides all rows to prevent misunderstandings.
...
...
...
...
If Not xlWB.ReadOnly Then
xlWB.ContentTypeProperties("TimesheetStatus") = strValidateWorkbook***
xlWB.ContentTypeProperties("OverrideStatus") = strNewOverrideStatus
xlWB.Save
End If