Příspěvky uživatele

Použijte následující kody
Makro se spustit přes 10 minut po otveření.
Otevřete vaše makro a pište

newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 600
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime

nebo
application.wait now()+ timevalue("00:10:00")

Tento kod se přeloží textu do čísla.

Sub ConvertToNumbers()
Cells.SpecialCells(xlCellTypeLastCell) _
.Offset(1, 1).Copy
Selection.PasteSpecial Paste:=xlPasteValues, _
Operation:=xlPasteSpecialOperationAdd
With Selection
.VerticalAlignment = xlTop
.WrapText = False
End With
Selection.EntireColumn.AutoFit
End Sub

Pokuste SpecialCells(xlCellTypeLastCell).Offset(1, 1) nahradit PoslBunka.Offset().

Použíjete následující odkazy i zkombinujte správný kod

http://www.mrexcel.com/forum/showthread.php?t=46961

http://www.techrepublic.com/blog/msoffice/quickly-export-outlook-e-mail-items-to-excel/744

http://www.eggheadcafe.com/tutorials/excel/edd4a3d0-7a24-47e8-98c2-e26898a2b7bb/getting-data-from-outlook-address-lists-into-excel.aspx

Přibližný kod
Private Sub GetOutlookAddressBook()

' Need to add reference to Outlook
'(In VBA editor Tools References MS Outlook #.# Library)
' Adds addresses to existing Sheet called Address and
' defines name Addresses containing this list
' For use with data Validation ListBox (Source as =Addresses)

On Error GoTo error

Dim objOutlook As Outlook.Application
Dim objAddressList As Outlook.AddressList
Dim objAddressEntry As Outlook.AddressEntry
Dim intCounter As Integer

' Setup connection to Outlook application
Set objOutlook = CreateObject("Outlook.Application")
Set objAddressList = objOutlook.Session.AddressLists("Contacts")

Application.EnableEvents = False

' Clear existing list
Sheets("Address").Range("A:A").Clear

'Step through each contact and list each that has an email address
For Each objAddressEntry In objAddressList.AddressEntries
If objAddressEntry.Address <> "" Then
intCounter = intCounter + 1
Application.StatusBar = "Address no. " & intCounter & " ... " & objAddressEntry.Address
Sheets("Address").Cells(intCounter, 1) = objAddressEntry.Address
DoEvents
End If
Next objAddressEntry

' Define range called "Addresses" to the list of emails
Sheets("Address").Cells(1, 1).Resize(intCounter, 1).Name = "Addresses"
error:
Set objOutlook = Nothing
Application.StatusBar = False
Application.EnableEvents = False
End Sub

Vylepšite ho k vložení než celý adresář a oddělený kontakt.

Podívejte se ne tyto odkazy
http://www.excelforum.com/excel-programming/646650-using-vb-to-upload-to-an-ftp.html

http://www.ozgrid.com/forum/showthread.php?t=47625

Přibližný kod:
'Written: June 11, 2008
'Author: Leith Ross

'Open the Internet object
Private Declare Function InternetOpen _
Lib "wininet.dll" _
Alias "InternetOpenA" _
(ByVal sAgent As String, _
ByVal lAccessType As Long, _
ByVal sProxyName As String, _
ByVal sProxyBypass As String, _
ByVal lFlags As Long) As Long

'Connect to the network
Private Declare Function InternetConnect _
Lib "wininet.dll" _
Alias "InternetConnectA" _
(ByVal hInternetSession As Long, _
ByVal sServerName As String, _
ByVal nServerPort As Integer, _
ByVal sUsername As String, _
ByVal sPassword As String, _
ByVal lService As Long, _
ByVal lFlags As Long, _
ByVal lContext As Long) As Long

'Get a file using FTP
Private Declare Function FtpGetFile _
Lib "wininet.dll" _
Alias "FtpGetFileA" _
(ByVal hFtpSession As Long, _
ByVal lpszRemoteFile As String, _
ByVal lpszNewFile As String, _
ByVal fFailIfExists As Boolean, _
ByVal dwFlagsAndAttributes As Long, _
ByVal dwFlags As Long, _
ByVal dwContext As Long) As Boolean

'Send a file using FTP
Private Declare Function FtpPutFile _
Lib "wininet.dll" _
Alias "FtpPutFileA" _
(ByVal hFtpSession As Long, _
ByVal lpszLocalFile As String, _
ByVal lpszRemoteFile As String, _
ByVal dwFlags As Long, _
ByVal dwContext As Long) As Boolean

'Close the Internet object
Private Declare Function InternetCloseHandle _
Lib "wininet.dll" _
(ByVal hInet As Long) As Integer

Sub UploadFTP()

'When uploading a file, make sure you have permisson to create a file on the server.
'The size limit for a uploading a file is 4GB.

Dim hostFile As String
Dim INet As Long
Dim INetConn As Long
Dim hostFile As String
Dim Password As String
Dim RetVal As Long
Dim ServerName As String
Dim Success As Long
Dim UserName As String

Const ASCII_TRANSFER = 1
Const BINARY_TRANSFER = 2

ServerName = "myserver.some.company"
UserName = "anonymous"
Password = "MyEmail@somewhere.net"
localFile = "C:\My Documents\Test.Txt"
hostFile = "\\My Test File.txt"

RetVal = False
INet = InternetOpen("MyFTP Control", 1&, vbNullString, vbNullString, 0&)
If INet > 0 Then
INetConn = InternetConnect(INet, ServerName, 0&, UserName, Password, 1&, 0&, 0&)
If INetConn > 0 Then
Success = FtpPutFile(INetConn, localFile, hostFile, BINARY_TRANSFER, 0&)
RetVal = InternetCloseHandle(INetConn)
End If
RetVal = InternetCloseHandle(INet)
End If

If Success <> 0 Then
MsgBox ("Upload process completed")
Else
MsgBox "FTP File Error!"
End If

End Sub

Dobrý den.
Použijte tento odkaz
http://excel.tips.net/T003158_Opening_a_Workbook_but_Disabling_Macros.html
Přečtete pozorně.
Na začátku makra AutoOpen i AutoClose vložte kody, kteří budou požádat k povolení nebo zakázání maker.

Příspěvky uživatele

Uživatelské menu

Menu

Formulář Faktura

Formulář Faktura IV

Helios iNuvio

On-line nástroje