Loading halaman Tutorial Visual Basic, Delphi, PHP - Calon Programer : Membuka Browser dengan alamat yang ada di text box ...




  1. '------------------------------------------------- -----  
  2.      'Object untuk membuat Project ini:  
  3.      'TextBox bernama txtWeb dengan teks diatur ke http://www.  
  4.      'tombol bernama cmdWeb  
  5.        
  6.     ' Listing module  
  7.     Dim success As Integer  
  8.     Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _  
  9.     (ByVal hwnd As LongByVal lpOperation As StringByVal lpFile As String, _   
  10.     ByVal lpParameters As StringByVal lpDirectory As StringByVal nShowCmd As LongAs Long  
  11.   
  12.     '------------------------------------------------------------------  
  13.        
  14.     'Listing Tombol  
  15.     Private Sub cmdWeb_Click()  
  16.     Dim success As Integer  
  17.     If Trim(txtWeb.Text) = "http://www." Or Trim(txtWeb.Text) = "" Then ' I have the txtWeb.text set to http://www.   
  18.         MsgBox "You don't have a web address entered for this entry", vbCritical, "Missing Data"  
  19.     ElseIf Left(Trim(txtWeb.Text), 11) = "http://www." Then  
  20.         Site = Trim(txtWeb.Text)  
  21.         ElseIf Left(Trim(txtWeb.Text), 4) = "www." Then  
  22.         Site = "http://" & Trim(txtWeb.Text)  
  23.         Else  
  24.     Site = "http://www." & Trim(txtWeb.Text)  
  25.     End If  
  26.     success% = ShellToBrowser(Me, Site, 0)  
  27.     End Sub  
  28.     '------------------------------------------------------------------  
  29.        
  30.     ' Here's the function code  
  31.     Function ShellToBrowser%(Frm As Form, ByVal URL$, ByVal WindowStyle%)  
  32.           
  33.         Dim api%  
  34.             api% = ShellExecute(Frm.hwnd, "open", URL$, "", App.Path, WindowStyle%)  
  35.        
  36.         'Check return value  
  37.         If api% <31 Then  
  38.             'error code - see api help for more info  
  39.             MsgBox App.Title & " had a problem running your web browser. & _ 
  40.               "You should check that your browser is correctly installed." & _ 
  41.               (Error" & Format$(api%) & ")", 48, "Browser Unavailable"  
  42.             ShellToBrowser% = False  
  43.         ElseIf api% = 32 Then  
  44.             'no file association  
  45.             MsgBox App.Title & " could not find a file association for " & _  
  46.               URL$ & " on your system. You should check that your browser" & _  
  47.               "is correctly installed and associated with this type of file.", 48, "Browser Unavailable"  
  48.             ShellToBrowser% = False  
  49.         Else  
  50.             'It worked!  
  51.             ShellToBrowser% = True  
  52.        
  53.         End If  
  54.           
  55.     End Function  
  56.   
  57.        
  58.     Private Sub cmdEmail_Click()  
  59.     Dim success As Integer  
  60.     If Trim(txtEmail.Text) = "" Then  ' Give an error if nothing is in the text box  
  61.             MsgBox "You don't have an email address entered for this entry", vbCritical, "Missing Data"  
  62.             Else  
  63.     Site = "mailto:" & Trim(txtEmail.Text)  
  64.     success% = ShellToBrowser(Me, Site, 0)  
  65.     End If  
  66.     End Sub                                          
  67.   
  68. Dim oApp As Outlook.Application  
  69. Dim oNameSpace As NameSpace  
  70. Dim oFolder As MAPIFolder  
  71. Dim oMailItem As Object  
  72. Dim sMessage As String  
  73.   
  74. Set oApp = New Outlook.Application  
  75. Set oNameSpace = oApp.GetNamespace("MAPI")  
  76. Set oFolder = oNameSpace.GetDefaultFolder(olFolderInbox)  
  77.   
  78.     For Each oMailItem In oFolder.Items  
  79.         With oMailItem  
  80.             If oMailItem.Attachments.Count > 0 Then '?  
  81.                oMailItem.Attachments.Item(1).SaveAsFile "C:\Temp\Outlook 
  82. Attachments\" & oMailItem.Attachments.Item(1).filename 
  83.                MsgBox oMailItem.Attachments.Item(1).DisplayName & " was  
  84. saved as " & oMailItem.Attachments.Item(1).filename  
  85.             End If  
  86.         End With  
  87.     Next oMailItem  
  88.   
  89. Set oMailItem = Nothing  
  90. Set oFolder = Nothing  
  91. Set oNameSpace = Nothing  
  92. Set oApp = Nothing  

Klik Like/share jika anda menyukai tulisan Share

Tagg :

0 Reply :

Posting Komentar

Jika ada pertanyaan atau request,Komentar pada tab blogger akan lebih memudahkan saya untuk membalasnya karena lebih mudah melakukan pengecekan komentar.