How would you go about opening a form in another project from a form..
Lets say i have such a project structure:
p1
frm1
frm2
p2
frmxyz
opening frm1 from frmxyz in VB6...? Something like:
p1.frm1.show() 'Maybe?
How do you do it?
There two different ways to resolve this issue:
1.)
You can add frm1 to project p2, with project -> add form -> tab "existing". After that you can easily access with frm1.show().
2.)
you create an interface object with a function to access the form compile the p1 as an active-x dll. in the next step, you can add the active-x dll as reference in p2 and show the form on calling the the function in the interface object.
It's faily complicated. The easiest way I figured how to do it is the following :
Sub UseExternalUserForm()
'Set the File name, File path, and Form name
Dim myForm As String, myDirectory As String, myFile As String
myDirectory = "C:\FilePath\"
myFile = "MyFile.xls"
myForm = "UserForm1"
'Start dealing with workbooks and their objects
Dim vbc As Object
Dim wb1 As Workbook, wb2 As Workbook
Set wb1 = ThisWorkbook
Set wb2 = Workbooks.Open(myDirectory & myFile)
If UserFormExists(2, myForm) Then
'Export the form if it exists
wb2.VBProject.VBComponents(myForm).Export (myForm & ".frm")
Else
'Display an error message if it doesn't
MsgBox myForm & " doesn't exist in " & wb2.Name
End If
wb2.Close False
If UserFormExists(1, myForm) Then
'Display an error message if it already exists
MsgBox myForm & " already exists in " & wb1.Name
Else
'Import the form if it doesn't
Set vbc = Application.VBE.vbProjects(1).VBComponents.Import(myForm & ".frm")
VBA.UserForms.Add(myForm).Show
'Remove the imported form
Application.VBE.vbProjects(1).VBComponents.Remove vbc
End If
End Sub
'How to figure out if a form already exists in a project (numbered with an integer representing the index
' of the project in the VBAProject Explorer)
Public Function UserFormExists(projectIndex As Integer, formName As String) As Boolean
On Error Resume Next
UserFormExists = (Application.VBE.vbProjects(projectIndex).VBComponents(formName).Name = formName)
On Error GoTo 0
End Function
Let me know if you need any extra explanations as to how to get this code to work for you.
Related
I have created an extension that extracts some parameters for the email and forwards it to our platform. It's working fine but now I want to make sure that my extension works even in preview mode. We don't have to open an email in order to use an extension.
I couldn't find any configuration to enable the plugin in preview mode.
It seems you need to handle the SelectionChange event of the Explorer class. It is fired when the user selects a different or additional Microsoft Outlook item programmatically or by interacting with the user interface. This event also occurs when the user (either programmatically or via the user interface) clicks or switches to a different folder that contains items, because Outlook automatically selects the first item in that folder. However, this event does not occur if the folder is a file-system folder or if any folder with a current Web view is displayed.
Public WithEvents myOlExp As Outlook.Explorer
Public Sub Initialize_handler()
Set myOlExp = Application.ActiveExplorer
End Sub
Private Sub myOlExp_SelectionChange()
MsgBox myOlExp.Selection.Count & " items selected."
End Sub
The Explorer.Selection property returns a Selection object that contains the item or items that are selected in the explorer window. Here is the sample how you can deal with the Selection object:
Sub GetSelectedItems()
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim mySender As Outlook.AddressEntry
Dim oMail As Outlook.MailItem
Dim oAppt As Outlook.AppointmentItem
Dim oPA As Outlook.PropertyAccessor
Dim strSenderID As String
Const PR_SENT_REPRESENTING_ENTRYID As String = "http://schemas.microsoft.com/mapi/proptag/0x00410102"
Dim MsgTxt As String
Dim x As Long
MsgTxt = "Senders of selected items:"
Set myOlExp = Application.ActiveExplorer
Set myOlSel = myOlExp.Selection
For x = 1 To myOlSel.Count
If myOlSel.Item(x).Class = OlObjectClass.olMail Then
' For mail item, use the SenderName property.
Set oMail = myOlSel.Item(x)
MsgTxt = MsgTxt & oMail.SenderName & ";"
ElseIf myOlSel.Item(x).Class = OlObjectClass.olAppointment Then
' For appointment item, use the Organizer property.
Set oAppt = myOlSel.Item(x)
MsgTxt = MsgTxt & oAppt.Organizer & ";"
Else
' For other items, use the property accessor to get the sender ID,
' then get the address entry to display the sender name.
Set oPA = myOlSel.Item(x).PropertyAccessor
strSenderID = oPA.GetProperty(PR_SENT_REPRESENTING_ENTRYID)
Set mySender = Application.Session.GetAddressEntryFromID(strSenderID)
MsgTxt = MsgTxt & mySender.Name & ";"
End If
Next x
Debug.Print MsgTxt
End Sub
I am using the script listed below (I honestly stole this probably from this very site) for a browse button on a form. The task is simply to start up MS File Dialog box so that a file (in this case an image file) can be selected. Once you select the record and click ok it then pastes the file name and location into a field.
Viewing the table the file name and location is pasted just as it should be. The problem comes in with a report I built. I have an image set to display with the control source linked back to that file address field. It will not display the image though.
However, if I manually type the same address character for character or even “copy”, delete, and then “paste” the same exact entry into the field the image then displays just fine on the report.
I have checked to make sure there are no spaces or characters anywhere there shouldn’t be. I am at a loss here.
Any help would be greatly appreciated and I will gladly give you my first born. Ok maybe not the first I like him but you can have the second one, she’s hell.
Private Sub Command67_Click()
On Error GoTo SubError
'Add "Microsoft Office 14.0 Object Library" in references
Const msoFileDialogFilePicker As Long = 3
'Dim FD As Office.FileDialog
Dim FDialog As Object
Dim varfile As Variant
Set FDialog = Application.FileDialog(msoFileDialogFilePicker)
EmployeePicture = ""
' Set up the File Dialog
Set FDialog = Application.FileDialog(msoFileDialogFilePicker)
With FDialog
.Title = "Choose the spreadsheet you would like to import"
.AllowMultiSelect = False
.InitialFileName = "C:\Users\" 'Folder picker needs trailing slash
.Filters.Clear
.Filters.Add "All", "*.*"
If .Show = True Then
If .SelectedItems.Count = 0 Then
'User clicked open but didn't select a file
GoTo SubExit
End If
'An option for MultiSelect = False
'varFile = .SelectedItems(1)
'EmployeePicture = varFile
'Needed when MultiSelect = True
For Each varfile In .SelectedItems
EmployeePicture = EmployeePicture & varfile & vbCrLf
Next
Else
'user cancelled dialog without choosing!
'Do you need to react?
End If
End With
SubExit:
On Error Resume Next
Set FDialog = Nothing
Exit Sub
SubError:
MsgBox "Error Number: " & Err.Number & " = " & Err.Description, vbCritical + vbOKOnly, _
"An error occurred"
GoTo SubExit
End Sub
I have both AutoCAD and AutoCAD Architecture installed on my system. AutoCAD Architecture has a tab called Vision Tools with a nifty command called Display By Layer to set the display order of objects in accordance with the layers of the drawing. Is there anyway to add this tab or use this command in AutoCAD?
Not sure if you're looking for a built-in feature or APIs for it.
For a built in feature, check the DRAWORDER command. For an API/programming approach, check the respective DrawOrderTable method. See below:
Update: please also check this 3rd party tool: DoByLayer.
[CommandMethod("SendToBottom")]
public void commandDrawOrderChange()
{
Document activeDoc
= Application.DocumentManager.MdiActiveDocument;
Database db = activeDoc.Database;
Editor ed = activeDoc.Editor;
PromptEntityOptions peo
= new PromptEntityOptions("Select an entity : ");
PromptEntityResult per = ed.GetEntity(peo);
if (per.Status != PromptStatus.OK)
{
return;
}
ObjectId oid = per.ObjectId;
SortedList<long, ObjectId> drawOrder
= new SortedList<long, ObjectId>();
using (Transaction tr = db.TransactionManager.StartTransaction())
{
BlockTable bt = tr.GetObject(
db.BlockTableId,
OpenMode.ForRead
) as BlockTable;
BlockTableRecord btrModelSpace =
tr.GetObject(
bt[BlockTableRecord.ModelSpace],
OpenMode.ForRead
) as BlockTableRecord;
DrawOrderTable dot =
tr.GetObject(
btrModelSpace.DrawOrderTableId,
OpenMode.ForWrite
) as DrawOrderTable;
ObjectIdCollection objToMove = new ObjectIdCollection();
objToMove.Add(oid);
dot.MoveToBottom(objToMove);
tr.Commit();
}
ed.WriteMessage("Done");
}
With some help from VBA it might look by this. Note i did not add fancy listbox code. I just show the worker and how to list layers. The trivial Code to add things to a listbox on a form and how to sort / rearrange listbox items can be found on any excel / VBA forum on the web . Or you just uses a predefined string like in the example. To get VBA to work download and install the acc. VBA Enabler from autocad. It is free.
'select all items on a layer by a filter
Sub selectALayer(sset As AcadSelectionSet, layername As String)
Dim filterType As Variant
Dim filterData As Variant
Dim p1(0 To 2) As Double
Dim p2(0 To 2) As Double
Dim grpCode(0) As Integer
grpCode(0) = 8
filterType = grpCode
Dim grpValue(0) As Variant
grpValue(0) = layername
filterData = grpValue
sset.Select acSelectionSetAll, p1, p2, filterType, filterData
Debug.Print "layer", layername, "Entities: " & str(sset.COUNT)
End Sub
'bring items on top
Sub OrderToTop(layername As String)
' This example creates a SortentsTable object and
' changes the draw order of selected object(s) to top.
Dim oSset As AcadSelectionSet
Dim oEnt
Dim i As Integer
Dim setName As String
setName = "$Order$"
'Make sure selection set does not exist
For i = 0 To ThisDrawing.SelectionSets.COUNT - 1
If ThisDrawing.SelectionSets.ITEM(i).NAME = setName Then
ThisDrawing.SelectionSets.ITEM(i).DELETE
Exit For
End If
Next i
setName = "tmp_" & time()
Set oSset = ThisDrawing.SelectionSets.Add(setName)
Call selectALayer(oSset, layername)
If oSset.COUNT > 0 Then
ReDim arrObj(0 To oSset.COUNT - 1) As ACADOBJECT
'Process each object
i = 0
For Each oEnt In oSset
Set arrObj(i) = oEnt
i = i + 1
Next
End If
'kills also left over selectionset by programming mistakes....
For Each selectionset In ThisDrawing.SelectionSets
selectionset.delete_by_layer_space
Next
On Error GoTo Err_Control
'Get an extension dictionary and, if necessary, add a SortentsTable object
Dim eDictionary As Object
Set eDictionary = ThisDrawing.modelspace.GetExtensionDictionary
' Prevent failed GetObject calls from throwing an exception
On Error Resume Next
Dim sentityObj As Object
Set sentityObj = eDictionary.GetObject("ACAD_SORTENTS")
On Error GoTo 0
If sentityObj Is Nothing Then
' No SortentsTable object, so add one
Set sentityObj = eDictionary.AddObject("ACAD_SORTENTS", "AcDbSortentsTable")
End If
'Move selected object(s) to the top
sentityObj.MoveToTop arrObj
applicaTION.UPDATE
Exit Sub
Err_Control:
If ERR.NUMBER > 0 Then MsgBox ERR.DESCRIPTION
End Sub
Sub bringtofrontbylist()
Dim lnames As String
'predefined layer names
layer_names = "foundation bridge road"
Dim h() As String
h = split(layernames)
For i = 0 To UBound(h)
Call OrderToTop(h(i))
Next
End Sub
'in case you want a fancy form here is how to get list / all layers
Sub list_layers()
Dim LAYER As AcadLayer
For Each LAYER In ThisDrawing.LAYERS
Debug.Print LAYER.NAME
Next
End Sub
to make it run put the cursor inside the VBA IDE inside the code of list_layers andpress F5 or choose it from the VBA Macro list.
I want to set a public folder to have an initial view (custom view), I know how to do it manually on outlook 2007, however, I cannot find any property or method i can use in the Interop (Folder and MAPI folder) that can do this.
After a few hours of googling, i came out the following:
Imports NUnit.Framework
Imports System.Windows.Forms
Imports System.Net.Mail
Imports System.Net.Mime
Imports System.Net
Imports System.Runtime.InteropServices
Imports Outlook = Microsoft.Office.Interop.Outlook
<TestFixture()>
Public Class TestOutlook
<Explicit()>
<Test()>
Public Sub TestSetFolderInitialView()
Dim ol As New Outlook.Application
Dim exCatched As Exception = Nothing
Try
' Get My Mailbox
Dim myFolder As Outlook.MAPIFolder = Nothing
For i As Integer = 0 To ol.Session.Folders.Count - 1
myFolder = ol.Session.Folders(i + 1)
If myFolder.Name = "Mailbox - Rex" Then ' Change it to your mail box name
Exit For
End If
Next
' Get the folder I want to Set initial view
Dim testFolder As Outlook.MAPIFolder = Nothing
If myFolder IsNot Nothing Then
For i As Integer = 0 To myFolder.Folders.Count - 1
Dim pFolder = myFolder.Folders(i + 1)
If pFolder.Name = "Inbox" Then
For Each fol As Outlook.MAPIFolder In pFolder.Folders
If fol.Name = "TestFolder" Then
testFolder = fol
Exit For
End If
Next
Exit For
End If
Next
End If
If testFolder IsNot Nothing Then
Try
' Create a test view
Dim newVw = CType(testFolder.Views.Add("RexTest-" & DateTime.Now.ToString("yyyyMMdd-hhmmss"),
Outlook.OlViewType.olTableView,
Outlook.OlViewSaveOption.olViewSaveOptionThisFolderEveryone),
Outlook.TableView)
newVw.LockUserChanges = True
newVw.Save()
newVw.Apply()
' PR_DEFAULT_VIEW_ENTRYID:
Dim ns = "http://schemas.microsoft.com/mapi/proptag/"
Dim PR_DEFAULT_VIEW_ENTRYID = "0x36160102"
Dim PR_FOLDER_XVIEWINFO_E = "0x36E00102"
Dim defaultVw = testFolder.PropertyAccessor.GetProperty(ns & PR_DEFAULT_VIEW_ENTRYID)
Dim xVwInfo = testFolder.PropertyAccessor.GetProperty(ns & PR_FOLDER_XVIEWINFO_E)
' the defaultVw is nothing for the first time (actually throw exception)
' if i manually change it from the outlook,
' the value will be something like: 000000004B593F3D35EF8C42AB181C105AE444D40700E46C905CB9ABE446AA44351902AFC40E000026BF7A8C000040DB82FE9B98724F9B222A9C9BDB42CD0000005CF0280000
' **** The problem is how to get the correct binary data for the newly created view so i can set it like this: *****
'testFolder.PropertyAccessor.SetProperty(ns & PR_DEFAULT_VIEW_ENTRYID, testFolder.PropertyAccessor.StringToBinary(newVw.Name))
Catch ex As Exception
' _log.Warn(String.Format("Error set initial view {0} to folder - {1}", newVw.Name, testFolder.Name), ex)
exCatched = ex
' First time error 'The property "http://schemas.microsoft.com/mapi/proptag/0x36160102" is unknown or cannot be found' will be shown
' If we set the initial view of the folder in the outlook, this error will go away
End Try
End If
Catch ex As Exception
Debug.WriteLine(ex.Message)
Debug.WriteLine(ex.StackTrace)
exCatched = ex
Finally
If ol IsNot Nothing Then
Marshal.ReleaseComObject(ol)
ol = Nothing
End If
End Try
If exCatched IsNot Nothing Then
Throw exCatched
End If
End Sub
End Class
Now the only left part is how to get the correct binary data from the newly created view. some clue to manipulate the binary value: http://microsoft.public.win32.programmer.messaging.narkive.com/x1fNHHA5/default-view
however it was written in a different language and I got no idea how to make it in vb or c#.
any help appreciated.
Have you tried MAPIFolder.CurrentView and MAPIFolder.Views?
I need a method to check the contents of the text entered to make sure they are correctly entering a folder path. So it needs to be in the format of:
Drive Letter :\ Folder
e.g. C:\My Documents
If they haven't typed in that format I need to stop and show a message telling them to double check.
I have tried the Filter function but I haven't quite got it to work. Any help would be awesome. I don't have any code to show because I am nto sure where to start.
I also tried the common dialog, but the user jsut needs the type the path, not select the file. All I want to check is if the text type is within that format DRIVE:\FOLDER, that is it. So if the type "BLAH" in the text bax a message says Hey you type a correct path.
In VB6, to test whether your text contains a valid folder:
If Len(Dir("c:\My Documents", vbDirectory))>0 Then
'it's a folder
End If
Have you thought of implemeting the common dialog control to allow the selection of a correct folder instead - it'll be much more likely to be accurate.
Some example code of folder browsing from here:
Private Sub Command1_Click()
On Error Resume Next
Const WINDOW_HANDLE = 0
Const NO_OPTIONS = 0
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(WINDOW_HANDLE, "select folder:", NO_OPTIONS, "C:Scripts")
Set objFolderItem = objFolder.Self
objPath = objFolderItem.Path
objPath = Replace(objPath, "", "\")
Print objPath
End Sub
Alternatively you could validate the folder first you could check for ":\" using eith instr or mid
then you could validate the folder and even include an option to create it if not present with the filesystemobject (needs a reference set) here it is in function form, you can pass the contents of the textbox for validation.
Function DirExists(pFile As String, Optional pCreate As Boolean = False)
'
Dim fso As New FileSystemObject
Dim vPath As Variant
Dim sPath As String
Dim y As Variant
DirExists = False
If fso.FolderExists(pFile) Then
DirExists = True
Else
If pCreate Then
vPath = Split(pFile, "\")
For Each y In vPath
sPath = sPath & y & "\"
If Not fso.FolderExists(sPath) Then
fso.CreateFolder (sPath)
If fso.FolderExists(pFile) Then
DirExists = True
Exit Function
End If
End If
Next
End If
End If
End Function