hello, I was trying to save a hicon, but my attempt was a failure.
as a reference this link in Delphi, but failed to translate correctly.
http://www.clubdelphi.com/trucos/index.php?id=575

OleCreatePictureIndirect not want to use because I want the best quality for the icon or cursor.

this is my ugly translation, I know how some functions like memset

Code:
Option Explicit

Private Type ICONDIRENTRY
   bWidth               As Byte                 '// Width of the image
   bHeight              As Byte                 '// Height of the image (times 2)
   bColorCount          As Byte                 '// Number of colors in image (0 if >=8bpp)
   bReserved            As Byte                 '// Reserved
   wPlanes              As Integer              '// Color Planes
   wBitCount            As Integer              '// Bits per pixel
   dwBytesInRes         As Long                 '// how many bytes in this resource?
   dwImageOffset        As Long                 '// where in the file is this image
End Type

Private Type ICONDIR
   idReserved           As Integer              '// Reserved
   idType               As Integer              '// resource type (1 for icons)
   idCount              As Integer              '// how many images?
   idEntries()          As ICONDIRENTRY         '//array follows.
End Type

Private Type MEMICONDIRENTRY
   bWidth               As Byte                 '// Width of the image
   bHeight              As Byte                 '// Height of the image (times 2)
   bColorCount          As Byte                 '// Number of colors in image (0 if >=8bpp)
   bReserved            As Byte                 '// Reserved
   wPlanes              As Integer              '// Color Planes
   wBitCount            As Integer              '// Bits per pixel
   dwBytesInRes         As Long                 '// how many bytes in this resource?
   nID                  As Integer              '// the ID
End Type

Private Type BITMAPINFOHEADER   ' structure used within icon image data
    biSize              As Long
    biWidth             As Long
    biHeight            As Long            ' always doubled for icons/cursors
    biPlanes            As Integer
    biBitCount          As Integer
    biCompression       As Long
    biSizeImage         As Long
    biXPelsPerMeter     As Long
    biYPelsPerMeter     As Long
    biClrUsed           As Long
    biClrImportant      As Long
End Type

Private Type RGBQUAD
    rgbBlue             As Byte
    rgbGreen            As Byte
    rgbRed              As Byte
    rgbReserved         As Byte
End Type

Private Type BITMAPINFO
    bmiHeader           As BITMAPINFOHEADER
    bmiColors           As RGBQUAD
End Type

Private Type ICONIMAGE '<---¿?¿
    icHeader            As BITMAPINFOHEADER
    RGBQUAD()           As Byte
    icXOR()             As Byte
    icAND()             As Byte
End Type

Private Type ICONINFO
    fIcon As Long
    xHotspot As Long
    yHotspot As Long
    hbmMask As Long
    hbmColor As Long
End Type

Private Type BITMAP
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type

Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function GetIconInfo Lib "user32.dll" (ByVal hIcon As Long, ByRef piconinfo As ICONINFO) As Long
Private Declare Function GetObject Lib "gdi32.dll" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, ByRef lpObject As Any) As Long
Private Declare Function VirtualAlloc Lib "kernel32.dll" (ByRef lpAddress As Any, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Private Declare Function VirtualFree Lib "kernel32.dll" (ByRef lpAddress As Any, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Private Declare Function GetDIBits Lib "gdi32.dll" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, ByRef lpBits As Any, ByRef lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function CreateFile Lib "kernel32.dll" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByRef lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Private Declare Function WriteFile Lib "kernel32.dll" (ByVal hFile As Long, ByRef lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, ByRef lpNumberOfBytesWritten As Long, ByRef lpOverlapped As Any) As Long
Private Declare Function CloseHandle Lib "kernel32.dll" (ByVal hObject As Long) As Long


Private Const GENERIC_WRITE As Long = &H40000000
Private Const CREATE_ALWAYS As Long = 2
Private Const FILE_ATTRIBUTE_NORMAL As Long = &H80
Private Const DIB_RGB_COLORS As Long = 0
Private Const MEM_COMMIT As Long = &H1000
Private Const MEM_RELEASE As Long = &H8000
Private Const PAGE_EXECUTE_READ As Long = &H20
Private Const PAGE_EXECUTE_READWRITE As Long = &H40
Private Const FILE_SHARE_READ As Long = &H1
Private Const FILE_SHARE_WRITE As Long = &H2
Private Const CREATE_NEW As Long = 1



Private Function NColors(ByVal bitCount As Long) As Boolean '< -- ?¿?¿?
  If (bitCount = 1 Or bitCount = 4 Or bitCount = 8) Then
    NColors = True
    Else
        If (bitCount >= 24) Then
            NColors = False
        End If
  End If
End Function

'//---------------------------------------------------------------------------
'// Devuelve una imagen de archivo.ico para poder guardar en disco....
'// Reserva la memoria necesaria devolviendo en Size el Tamaño
'// Requiere liberar luego la memoria con VirtualFree(Mem, 0, MEM_RELEASE);
Private Function hIconToMem(hIcon As Long, BitCountPerPixel As Integer, ByRef Size As Integer) As Long
    Dim hdc As Long
    Dim bmpAND As BITMAP
    Dim bmpXOR As BITMAP
    Dim IcoInfo As ICONINFO
    Dim IcoDir As ICONDIR
    Dim RawDataSizeAND As Integer
    Dim RawDataSizeXOR As Integer
    Dim RawDataSize As Integer
    Dim PalSize As Integer
    Dim AllSize As Integer
    Dim Width As Long, Height As Long
    Dim FileIconMem As Long
    Dim IcoImage As ICONIMAGE
    Dim bmiAND As BITMAPINFO
    Dim bmiICON As BITMAPINFO
    Dim BINFOH As BITMAPINFOHEADER
    Dim lpBitsXOR As Long
    Dim lpBitsAND As Long
    
    
    hdc = GetDC(0)
    GetIconInfo hIcon, IcoInfo

    Call GetObject(IcoInfo.hbmMask, LenB(bmpAND), bmpAND)
    Call GetObject(IcoInfo.hbmColor, LenB(bmpXOR), bmpXOR)
     
    If (BitCountPerPixel = 0) Then BitCountPerPixel = bmpXOR.bmPlanes * bmpXOR.bmBitsPixel


    RawDataSizeAND = (((bmpAND.bmWidth + 31) And Not 31) \ 8) * bmpAND.bmHeight   '((((bmpAND.bmWidth * bmpAND.bmBitsPixel) + 31) & -31) > 3) * bmpAND.bmHeight
    RawDataSizeXOR = (((bmpXOR.bmWidth + 31) And Not 31) \ 8) * bmpXOR.bmHeight '((((bmpXOR.bmWidth * BitCountPerPixel) + 31) & -31) > 3) * bmpXOR.bmHeight
    RawDataSize = RawDataSizeAND + RawDataSizeXOR
    'PalSize=(BitCountPerPixel>8 ? 0 :1 << BitCountPerPixel)<<2; // RGBQUAD 4
    AllSize = LenB(IcoDir) + LenB(BINFOH) + PalSize + RawDataSizeAND + RawDataSizeXOR
    Width = bmpAND.bmWidth
    Height = bmpAND.bmHeight
    
    FileIconMem = VirtualAlloc(0, AllSize, MEM_COMMIT, PAGE_EXECUTE_READWRITE)
        
    
    ReDim IcoDir.idEntries(0)
    
    With IcoDir
        .idReserved = 0
        .idType = 1
        .idCount = 1
        .idEntries(0).bWidth = Width
        .idEntries(0).bHeight = Height
        .idEntries(0).bColorCount = NColors(BitCountPerPixel)
        .idEntries(0).bReserved = 0
        .idEntries(0).wPlanes = 0           '// Color Planes
        .idEntries(0).wBitCount = 0         '//BitCountPerPixel;       // Bits per pixel
        .idEntries(0).dwBytesInRes = AllSize - LenB(IcoDir)   '// How many bytes in this resource?
        .idEntries(0).dwImageOffset = LenB(IcoDir)   '// Where in the file is this image?
    End With
  
    'memset(IconImage, 0, sizeof(BITMAPINFOHEADER));
    
    With IcoImage
        .icHeader.biSize = LenB(BINFOH)
        .icHeader.biWidth = Width
        .icHeader.biHeight = Height
        .icHeader.biPlanes = 1
        .icHeader.biBitCount = BitCountPerPixel
        .icHeader.biSizeImage = RawDataSize
    End With
    
    
    'memcpy(&bmiAND, bmiICON, sizeof(BITMAPINFOHEADER));
    With bmiAND
        .bmiHeader.biSizeImage = RawDataSizeAND
        .bmiHeader.biBitCount = 1
        .bmiHeader.biClrUsed = 1
        .bmiHeader.biClrImportant = 1
    End With
    
    '// Recupero los bits de cada hBitmap del icono
    GetDIBits hdc, IcoInfo.hbmColor, 0, Height, lpBitsXOR, bmiICON, DIB_RGB_COLORS
    GetDIBits hdc, IcoInfo.hbmMask, 0, Height, lpBitsAND, bmiAND, DIB_RGB_COLORS
    
    IcoImage.icHeader.biHeight = Height * 2

    ReleaseDC 0, hdc
    
    Size = AllSize
    hIconToMem = FileIconMem
End Function


Private Sub Form_Load()
Dim hIcon As Long
Dim Size As Integer
Dim FileIconMem As Long
Dim hFile As Long
Dim dwWritten As Long

hIcon = Me.Icon
   
'// Convertimos el HICON a imagen en memoria del .ico

FileIconMem = hIconToMem(hIcon, 32, Size)


hFile = CreateFile("C:\FilePath.ico", GENERIC_WRITE, FILE_SHARE_WRITE, ByVal 0&, CREATE_NEW, 0, 0)

WriteFile hFile, FileIconMem, Size, dwWritten, 0

CloseHandle hFile

Call VirtualFree(FileIconMem, 0, MEM_RELEASE)

End Sub