Umm una de las formas es obteniendo el codigo fuente de la pag y luego ubicar el nombre del video:
Funcion para obtener el codigo fuente de la web by Mr. Frog ©
- Option Explicit 
-   
- Private Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long 
- Private Declare Function InternetOpenUrl Lib "wininet" Alias "InternetOpenUrlA" (ByVal hInternetSession As Long, ByVal lpszUrl As String, ByVal lpszHeaders As String, ByVal dwHeadersLength As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long 
- Private Declare Function InternetReadFile Lib "wininet" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, lNumberOfBytesRead As Long) As Integer 
- Private Declare Function InternetCloseHandle Lib "wininet" (ByVal hInet As Long) As Integer 
-   
- Private Const IF_NO_CACHE_WRITE As Long = &H4000000 
-   
- Public Function Get_Html_Code(ByRef sURL As String) As String 
-   
-     Dim sBuffer   As String * 1000 
-     Dim lInternet As Long 
-     Dim lFile     As Long 
-     Dim lRead     As Long 
-   
-     lInternet = InternetOpen(0, 1, vbNullString, vbNullString, 0) 
-   
-     If lInternet Then 
-         lFile = InternetOpenUrl(lInternet, sURL, vbNullString, 0, IF_NO_CACHE_WRITE, 0) 
-         If lFile Then 
-             Do 
-                 Call InternetReadFile(lFile, sBuffer, 1000, lRead): DoEvents 
-                 Get_Html_Code = Get_Html_Code & Left$(sBuffer, lRead) 
-             Loop While lRead 
-         End If 
-         Call InternetCloseHandle(lInternet) 
-     End If 
-   
- End Function 
-   
- Private Sub Form_Load() 
-   
-     Dim TempString As String 
-   
-     TempString = Get_Html_Code("http://www.youtube.com/watch?v=feFLXc2m_vA&feature=topvideos") 
-   
-     MsgBox GetVideoName(TempString) 
-   
- End Sub 
-   
- Function GetVideoName(RespText As String) As String 
-   
-     Dim pos1, pos2 As Integer 
-     Dim tmp1, tmp2, tmp3 As String 
-   
-     If InStr(1, RespText, "content") Then 
-   
-         pos1 = InStr(1, RespText, "content=") 
-         pos2 = InStr(pos1, RespText, ">") 
-         tmp1 = Mid(RespText, pos1, pos2 - pos1 - 1) 
-         tmp2 = Replace(tmp1, "content=", "") 
-         tmp3 = Replace(tmp2, Chr(&H22), "") 
-   
-     End If 
-   
-     GetVideoName = Trim(tmp3) 
-   
- End Function 
-