Pasti Semangat dong Pa

makroh Sudah di coba, sayangnya dari tadi gagal terus melampirkan
sample workbooknya
dan kebetulan, pernah juga mengmbil data dari tabel di web. saya cuma
modif dikit disesuaikan dengan kebutuhan Anda.. karena untuk modul
aslinya looping kebanyak file di satu folder lalu capture table dan
transpose secara array

Copy paste coding berikut di modul standard, lalu
untuk penyimpanan,  saya lakukan di F Drive, ganti jika perlu

Run makroh : ConvertWebTabel


Option Explicit
Option Compare Text
Public Path         As String
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000
Private Const MAX_PATH As Long = 260
Type BrowseInfo
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszINSTRUCTIONS As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type

Type SHFILEOPSTRUCT
    hwnd As Long
    wFunc As Long
    pFrom As String
    pTo As String
    fFlags As Integer
    fAnyOperationsAborted As Boolean
    hNameMappings As Long
    lpszProgressTitle As String
End Type

Declare Function SHGetPathFromIDListA Lib "shell32.dll" ( _
ByVal pidl As Long, _
ByVal pszBuffer As String) As Long
Declare Function SHBrowseForFolderA Lib "shell32.dll" ( _
lpBrowseInfo As BrowseInfo) As Long

Function BrowseFolder(Optional Caption As String = "") As String

    Dim BrowseInfo As BrowseInfo
    Dim FolderName As String
    Dim ID As Long
    Dim Res As Long

    With BrowseInfo
        .hOwner = 0
        .pidlRoot = 0
        .pszDisplayName = String$(MAX_PATH, vbNullChar)
        .lpszINSTRUCTIONS = Caption
        .ulFlags = BIF_RETURNONLYFSDIRS
        .lpfn = 0
    End With
    FolderName = String$(MAX_PATH, vbNullChar)
    ID = SHBrowseForFolderA(BrowseInfo)
    If ID Then
        Res = SHGetPathFromIDListA(ID, FolderName)
        If Res Then
            BrowseFolder = Left$(FolderName, InStr(FolderName, _
            vbNullChar) - 1)
        End If
    End If

End Function

Sub ConvertWebTabel()
Dim FileName        As String
Dim PathNfile As String
Dim NmFile As String

Const MainPath As String = "F:\"

        Path = BrowseFolder
        FileName = Dir(Path & "\MONITORING EKSTENSIFIKASI WAJIB PAJAK
KARYAWAN example.MHT", vbNormal)
        Workbooks.Open FileName:=Path & "\" & FileName

NmFile = Application.InputBox("Masukan Nama File baru :" & vbCrLf _
& vbNewLine & "Menyalin ke File Baru")
PathNfile = MainPath & "\"
   ActiveWorkbook.SaveAs FileName:=PathNfile & NmFile, _
      FileFormat:=xlExcel9795, Password:="", WriteResPassword:="", _
      ReadOnlyRecommended:=False, CreateBackup:=False
   ActiveWorkbook.Close
           MsgBox "File telah tersimpan di: " & vbCrLf _
           & PathNfile & NmFile & vbCrLf _
           & "Silahkan cek melalui explorer", vbInformation, "Informasi Saja"
End Sub





Pada tanggal 24/03/09, rizaldi <[email protected]> menulis:
> Saya ingin mengambil data dari suatu halaman web, yang kebetulan berupa
> tabel2..
>
> Data yang ingin saya ambil terletak pada suatu portal,,,,dan untuk
> memperoleh datanya saya harus mengklik link nya
>
> Kebetulan saya sudah punya linknya (sangat buanyak)
>
> Contohnya seperti seperti ini : attached file
>
>
>
> SEMANGAT..
>
>
>
>
>
>
>
>
>
>
>
>
>
>

Kirim email ke