I have a serious problem with my VB 6 application. In it, I have a reference to wmp.dll in a Form, the idea it's play media video files, i have a ListView called LV1 in which I show the playlist filenames. I wish to know the current index from the current Playlist.
This sub is in charge of detecting the changes:
Private Sub Wmp1_CurrentItemChange(ByVal pdispMedia As Object)
I can get the totall count into the playlist with this line:
Val=Wmp1.currentPlaylist.Count
How I can obtain the current track (index) in reproduction, if i want coordinate this with my ListView, to select the same track with the same index into the playlist.
Thanks for your help.
You can use setItemInfo on the media before adding to currentPlaylist like this:
Option Explicit
Private Sub Form_Load()
Dim sFile As String
Dim oMedia As IWMPMedia
sFile = Dir("c:\temp\*.avi")
Do While LenB(sFile) <> 0
Set oMedia = Wmp1.newMedia("c:\temp\" & sFile)
oMedia.setItemInfo "Index", Wmp1.currentPlaylist.Count
Wmp1.currentPlaylist.appendItem oMedia
sFile = Dir
Loop
End Sub
Private Sub Wmp1_CurrentItemChange(ByVal pdispMedia As Object)
Debug.Print Wmp1.currentPlaylist.Item(Wmp1.currentMedia.getItemInfo("Index")).Name
End Sub
This is the answer. You have to search again in the loop
Dim i As Integer
For i = 0 To WindowsMediaPlayer1.currentPlaylist.Count - 1
If WindowsMediaPlayer1.currentPlaylist.Item(i).isIdentical(WindowsMediaPlayer1.currentMedia) = True Then Exit For
Next
List1.Selected(i) = True
Related
I would like to automate my MS Outlook inbox. The idea is to move all emails (i) with a specific sender address and (ii) older than 7 days as of today into a subfolder to my inbox. Please see working example below (you may need to adjust folder names so it works on you machine).
My problem: after 88 iterations I run into a "run time error 13, type mismatch". Why does this happen after so many iterations? And, more importantly, how to fix it? Any ideas?
All default libraries are enabled on my VBE. I am using MS Office 2019.
Thank you!
'On Error Resume Next
On Error GoTo 0
'-----------------------------------------------------------------------------------------
' declare variables
'-----------------------------------------------------------------------------------------
Dim objSourceFolder As MAPIFolder
Dim objDestinationFolder As MAPIFolder
Dim objMail As MailItem ' single email
Dim objMails As Items ' all emails in source folder
Dim lngItems As Long ' number of checked emails
Dim intDays As Integer ' number of days
Dim counter As Integer ' number of moved emails
'-----------------------------------------------------------------------------------------
' email age in days
'-----------------------------------------------------------------------------------------
intDays = 7
'-----------------------------------------------------------------------------------------
' define folder (= inbox)
'-----------------------------------------------------------------------------------------
Set objSourceFolder = GetNamespace("Mapi").GetDefaultFolder(olFolderInbox)
'-----------------------------------------------------------------------------------------
' reference items in source folder
'-----------------------------------------------------------------------------------------
Set objMails = objSourceFolder.Items
'objMails.Count
'-----------------------------------------------------------------------------------------
' sort emails in source folder (oldest first)
'-----------------------------------------------------------------------------------------
objMails.Sort "ReceivedTime", False
'-----------------------------------------------------------------------------------------
' move email
'-----------------------------------------------------------------------------------------
For Each objMail In objMails
If objMail.ReceivedTime < Now - intDays Then
Select Case objMail.SenderEmailAddress
Case "mailrobot#mail.xing.com":
Set objDestinationFolder = GetNamespace("Mapi").Folders(1).Folders("Inbox").Folders("Xing")
End Select
If objDestinationFolder Is Nothing Then
Else: objMail.Move objDestinationFolder
counter = counter + 1
End If
lngItems = lngItems + 1
End If
Next
End Sub
Your code assumes that you can only have MailItem objects in the Inbox folder. You an also have ReportItem and MeetingItem objects.
Declare objMail as a generic Object and in the loop check first that the Class property is 43 (OlObjectClass.olMail)
I'm trying to add records to an exisiting table called "Topics" (section as of "For Each SelectedTopic In SelectedTopicsCtl.ItemsSelected" in the code below).
When executing the code i always get "Run-time error '3022': The changes you requested to the table were not successful because they would create duplicate values in the index, primary key, or relationship. So it goes wrong at the creation of the Autonumber in the field "ID" (= the only field that is indexed - no duplicates).
When debugging, line "TopicRecord.Update" in the code below is highlighted.
I have read several posts on this topic on this forum and on other forums but still cannot get this to work - i must be overlooking something....
Private Sub Copy_Click()
Dim JournalEntrySourceRecord, JournalEntryDestinationRecord, TopicRecord As Recordset
Dim JournalEntryToCopyFromCtl, JournalEntryToCopyToCtl, JournalEntryDateCreatedCtl, SelectedTopicsCtl As Control
Dim Counter, intI As Integer
Dim SelectedTopic, varItm As Variant
Set JournalEntryToCopyFromCtl = Forms![Copy Journal Entry]!JournalEntryToCopyFrom
Set JournalEntryToCopyToCtl = Forms![Copy Journal Entry]!JournalEntryToCopyTo
Set JournalEntryDateCreatedCtl = Forms![Copy Journal Entry]!JournalEntryDateCreated
Set JournalEntrySourceRecord = CurrentDb.OpenRecordset("Select * from JournalEntries where ID=" & JournalEntryToCopyFromCtl.Value)
Set JournalEntryDestinationRecord = CurrentDb.OpenRecordset("Select * from JournalEntries where ID=" & JournalEntryToCopyToCtl.Value)
Set SelectedTopicsCtl = Forms![Copy Journal Entry]!TopicsToCopy
Set TopicRecord = CurrentDb.OpenRecordset("Topics", dbOpenDynaset, dbSeeChanges)
With JournalEntryDestinationRecord
.Edit
.Fields("InitiativeID") = JournalEntrySourceRecord.Fields("InitiativeID")
.Fields("DateCreated") = JournalEntryDateCreatedCtl.Value
.Fields("Comment") = JournalEntrySourceRecord.Fields("Comment")
.Fields("Active") = "True"
.Fields("InternalOnly") = JournalEntrySourceRecord.Fields("InternalOnly")
.Fields("Confidential") = JournalEntrySourceRecord.Fields("Confidential")
.Update
.Close
End With
JournalEntrySourceRecord.Close
Set JournalEntrySourceRecord = Nothing
Set JournalEntryDestinationRecord = Nothing
For Each SelectedTopic In SelectedTopicsCtl.ItemsSelected
TopicRecord.AddNew
For Counter = 3 To SelectedTopicsCtl.ColumnCount - 1
TopicRecord.Fields(Counter) = SelectedTopicsCtl.Column(Counter, SelectedTopic)
Next Counter
TopicRecord.Fields("JournalEntryID") = JournalEntryToCopyToCtl.Value
TopicRecord.Fields("DateCreated") = JournalEntryDateCreatedCtl.Value
TopicRecord.Update
Next SelectedTopic
TopicRecord.Close
Set TopicRecord = Nothing
End Sub
First, your Dims won't work as you expect. Use:
Dim JournalEntrySourceRecord As Recordset
Dim JournalEntryDestinationRecord As Recordset
Dim TopicRecord As Recordset
Second, it looks like you get your ID included here:
TopicRecord.Fields(Counter)
or Topic is a query that includes it somehow. Try to specify the fields specifically and/or debug like this:
For Counter = 3 To SelectedTopicsCtl.ColumnCount - 1
TopicRecord.Fields(Counter).Value = SelectedTopicsCtl.Column(Counter, SelectedTopic)
Debug.Print Counter, TopicRecord.Fields(Counter).Name
Next Counter
I have developed a small VBA macro in Excel that's supposed to add the values of cells in row 15 to the values of cells in row 6 during workbook change (in my case entering a number in row 15 and pressing tab).
Initially, I developed and used it in Excel 2013, then I have switched to Mac and have since used it in Excel for Mac 2011. Now, I have installed Excel for Mac 2016 and all of a sudden, the macro doesn't work anymore.
This is the script:
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C15:H15")) > 0 Then
Call copySub
End If
End Sub
Sub copySub()
Sheets("sheet1").Protect , UserInterFaceOnly:=True
For i = 3 To 8
Cells(6, i).Value = Cells(6, i).Value + Cells(15, i).Value
Cells(15, i).Value = 0
Next i
End Sub
When I enter a value and press tab in Excel 2016, I get the runtime error 91 "Object variable or With block variable not set". The error seems to occur in the line:
Cells(6, i).Value = Cells(6, i).Value + Cells(15, i).Value
I have also tried to store the sum in a variable before assigning it to Cells(6, i).Value, but that didn't help either.
Did Microsoft change the logic of the sheet protection, especially with the parameter UserInterFaceOnly set to true? Or what's going on here?
I hope you can help me.
Thanks,
chuky
Are you sure you've copied this code correctly? There's no way it would work in any version of Excel.
Your problems are these:
Intersect returns a Range object so your code would throw a 91 error.
There's most likely a case error in your line Sheets("sheet1").Protect ... as it's probably called "Sheet1". If so, this would throw a 91 error.
If you changed that worksheet name from "sheet1", it'd throw a 91 error.
Why are you only protecting the sheet at Worksheet_Change. This should really be done in Workbook_Open? And if you do that, how does the user change the cells without specific cells being free from protection?
It's unclear which worksheets you're referring to and where the copySub routine is held. I've updated your code as it is to remove the main errors and written in the capacity to nominate your worksheet - you'll have to adjust that as you wish. Good luck.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Set ws = Target.Worksheet
If Not Intersect(Target, ws.Range("C15:H15")) Is Nothing Then
Call copySub(ws)
End If
End Sub
Sub copySub(ws As Worksheet)
ws.Protect , UserInterFaceOnly:=True
Application.EnableEvents = False
For i = 3 To 8
ws.Cells(6, i).Value = ws.Cells(6, i).Value + ws.Cells(15, i).Value
ws.Cells(15, i).Value = 0
Next i
Application.EnableEvents = True
End Sub
I'm very new (1 week) to visual basic and basically I'm trying to automate some repetitive work, now to the point , within a number of files produced with varying data I need to format the selected range as a table (medium 9) but i'm in a block at the moment and need some help and would really appreciate it, here is what i have so far>>>>
Option Explicit
Dim strDate, strRepDate, strPath, strPathRaw , strDate2
dim dteTemp, dteDay, dteMth, dteYear, newDate, myDate
myDate = Date()
dteTemp = DateAdd("D", -1, myDate)
dteDay = DatePart("D", dteTemp)
dteMth = DatePart("M", dteTemp)
dteYear = DatePart("YYYY", dteTemp)
If (Len(dteDay) = 1) Then dteDay = "0" & dteDay
If (Len(dteMth) = 1) Then dteMth = "0" & dteMth
strDate = dteYear&"-"&dteMth&"-"&dteDay
strDate2 = dteYear&""&dteMth&""&dteDay
Dim objXLApp, objXLWb, objXLWs
Set objXLApp = CreateObject("Excel.Application")
Set objXLWb = objXLApp.Workbooks.Open("C:\Users\CuRrY\Desktop\"&strDate2&"\Agent Daily Disposition "&strDate2&".xls")
objXLApp.Application.Visible = True
'start excell
Set objXLWs = objXLWb.Sheets(1)
'objXLWs.Cells(Row, Column ).Value
With objXLWs
objXLWs.Cells(3, 1).Value = "Agent Name"
'objXLWs.Range("A3").Select
objXLWs.Range("A3").CurrentRegion.Select
'End With
as you can see i reached as far as CurrentRegion.Select but how to format selected cells into (medium 9) i've tried so much and failed
Thanks for any help
You can configure the CurrentRegion(which represents a Range object) through the SpecialCells Submethod. Although your conditions are specific to your xls sheet, you will still have to follow the formatting available through the specialcells() method properties. Also, by utilizing the currentregion property, the page assumes you have a xls header. So it is important to verify your table structure before trying to incorporate this property.
For instance:
Sub FillIn()
Range("A1").CurrentRegion.SpecialCells(xlCellTypeBlanks).FormulaR1C1 _
= "=R[-1]C"
Range("A1").CurrentRegion.Value = Range("A1").CurrentRegion.Value
End Sub
View the available properties that can be applied to CurrentRegion -> Here
And the MSDN Article -> Here
I am very new with programming and I have come across an issue in Visual Basic that I cannot figure out. Many forums and YouTube videos later I still do not have an answer.
I am using a nested selection structure and within it is two Message boxes. I cannot figure out how to get the second dialog result to trigger the elseif statement. It just skips over it. I believe since I have one variable declared for a dialog result it is checking both of them, but in this case I don't know how to declare only the second dialog result.
Here is the code so far.
Dim dblTotal As Double = 12
Dim strResponse As DialogResult
' Dialog box asking about a coupon and $2 coupon.
If MessageBox.Show("Does customer have a coupon?", "Coupon", MessageBoxButtons.YesNo) = vbYes AndAlso
MessageBox.Show("Does customer have a $2 coupon?", "Coupon", MessageBoxButtons.YesNo) = vbNo Then
lblTotal.Text = Convert.ToString(dblTotal - 4)
' Meant to be ran if statement is false. I dont Understand
' why it is skipping over and not executing.
' Is "dlgResult" reading the first one as well? How do I correct?
ElseIf strResponse = vbYes Then
lblTotal.Text = Convert.ToString(dblTotal - 2)
Else
lblTotal.Text = Convert.ToString(dblTotal)
End If
End Sub
I understand it would be easier to to code if the first message = vbNo, but I was trying to see if this way would work.
Thank you!!
Is this how you wanted it?
Dim dialog1 As DialogResult
Dim dialog2 As DialogResult
Dim dblTotal As Double = 12
dialog1 = MessageBox.Show("Does customer have a coupon?", "Coupon", MessageBoxButtons.YesNo)
dialog2 = MessageBox.Show("Does customer have a $2 coupon?", "Coupon", MessageBoxButtons.YesNo)
If dialog1 = DialogResult.OK Then
dblTotal = dblTotal - 2
End If
If dialog2 = DialogResult.OK Then
dblTotal = dblTotal - 2
End If
lblTotal.Text = Convert.ToString(dblTotal - 2)