vba获取系统时间并自动写到另一个指定的excel文件里

假设另一个指定文件为bxls，与代码所在工作簿处于同一文件夹中。。

时间和textbox内容要分别写入到其Sheet1的A、B两列

则该按钮的代码为

Private Sub CommandButton1_Click()

Dim wb As Workbook, aR As Long, bR As Long

Set wb = WorkbooksOpen(ThisWorkbookPath & "\bxls", , False)

With wbWorksheets(1)

    aR = IIf(ApplicationCountA(Range("A:A")) = 0, 1, Cells(RowsCount, 1)End(3)Row + 1)

    bR = IIf(ApplicationCountA(Range("B:B")) = 0, 1, Cells(RowsCount, 1)End(3)Row + 1)

    Cells(aR, 1) = Format(Now, "yyyy-mm-dd hh:mm:ss")

    Cells(bR, 2) = TextBox1Text

End With

wbClose True

TextBox1 = ""

End Sub

亲，请查收附件。

一共两个按钮：

第一步：指定文件夹

第二步：运行程序批量修改日期

注意：请在运行前备份您的源文件。

Sub 年月日()

Dim FullName As String

Dim howdate As Date

Dim stringdate As String

Dim aname As String, bname As String, cname As String

ApplicationScreenUpdating = False

howdate = Now()

stringdate = howdate

aname = Mid(stringdate, 1, InStr(stringdate, "-") - 1)

stringdate = Mid(stringdate, InStr(stringdate, "-") + 1, Len(stringdate))

bname = Mid(stringdate, 1, InStr(stringdate, "-") - 1)

stringdate = Mid(stringdate, InStr(stringdate, "-") + 1, Len(stringdate))

cname = Mid(stringdate, 1, InStr(stringdate, " ") - 1)

stringdate = Mid(stringdate, InStr(stringdate, " ") + 1, Len(stringdate))

FullName = ThisWorkbookPath & "\" & aname & bname & cname & "txt"

Open FullName For Output As #1

Print #1, "" & stringdate

Print #1, aname

Close #1

ApplicationScreenUpdating = True

MsgBox "生成完毕"

End Sub

给你一个例子，从网上找的参考我稍微改了一下，我是在A1中填入了一个形如2012-2-14 14:05:08的日期，然后调用apiSetFileTime(文件名,最后修改时间,创建时间,访问时间)

如果只需要改最后访问时间，其它两个时间用""空值就可以了。

Option Explicit

Private Const OF_READWRITE = &H2

Private Const OFS_MAXPATHNAME = 128

Private Type FILETIME

dwLowDateTime As Long

dwHighDateTime As Long

End Type

Private Type SYSTEMTIME

wYear As Integer

wMonth As Integer

wDayOfWeek As Integer

wDay As Integer

wHour As Integer

wMinute As Integer

wSecond As Integer

wMilliseconds As Integer

End Type

Private Type OFSTRUCT

cBytes As Byte

fFixedDisk As Byte

nErrCode As Integer

Reserved1 As Integer

Reserved2 As Integer

szPathName(OFS_MAXPATHNAME) As Byte

End Type

Private Declare Function SystemTimeToFileTime Lib "kernel32" ( _

lpSystemTime As SYSTEMTIME, _

lpFileTime As FILETIME) As Long

Private Declare Function LocalFileTimeToFileTime Lib "kernel32" ( _

lpLocalFileTime As FILETIME, _

lpFileTime As FILETIME) As Long

Private Declare Function SetFileTime Lib "kernel32" ( _

ByVal hFile As Long, _

lpCreationTime As FILETIME, _

lpLastAccessTime As FILETIME, _

lpLastWriteTime As FILETIME) As Long

Private Declare Function OpenFile Lib "kernel32" ( _

ByVal lpFileName As String, _

lpReOpenBuff As OFSTRUCT, _

ByVal wStyle As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Sub test()

Dim t As String

t = Format(Range("a1")Value, "yyyy/mm/dd HH:mm:ss")

If apiSetFileTime("e:\md5exe", t, t, t) Then MsgBox "修改成功" Else MsgBox "修改失败"

End Sub

Function apiSetFileTime(ByVal PathName As String, ByVal LastWriteTime As String, Optional ByVal CreationTime As String, Optional ByVal LastAccessTime As String) As Boolean

Dim fs, f, s

Set fs = CreateObject("ScriptingFileSystemObject")

Set f = fsGetFile(PathName)

Dim myLastWriteTime, myCreationTime, myLastAccessTime

myLastWriteTime = IIf(LastWriteTime = "", fDateLastModified, LastWriteTime)

myCreationTime = IIf(CreationTime = "", fDateCreated, CreationTime)

myLastAccessTime = IIf(LastAccessTime = "", fDateLastAccessed, LastAccessTime)

Dim rtn As Long

Dim hFile As Long

Dim ofs As OFSTRUCT

Dim lpCreationTime As FILETIME

Dim lpLastWriteTime As FILETIME

Dim lpLastAccessTime As FILETIME

If CreationTime = "" Then CreationTime = LastWriteTime

If LastAccessTime = "" Then LastAccessTime = LastWriteTime

lpCreationTime = TransformTime(myCreationTime)

lpLastWriteTime = TransformTime(myLastWriteTime)

lpLastAccessTime = TransformTime(myLastAccessTime)

hFile = OpenFile(PathName, ofs, OF_READWRITE)

rtn = SetFileTime(hFile, lpCreationTime, lpLastAccessTime, lpLastWriteTime)

If rtn = 1 Then apiSetFileTime = True

CloseHandle hFile

End Function

Private Function TransformTime(ByVal NewDate As String) As FILETIME

Dim fTime As FILETIME

Dim fLTime As FILETIME

Dim fSysTime As SYSTEMTIME

With fSysTime '参数 NewDate 的格式 : "yyyy/mm/dd HH:mm:ss"

wYear = Year(NewDate)

wMonth = Month(NewDate)

wDay = Day(NewDate)

wHour = Hour(NewDate)

wMinute = Minute(NewDate)

wSecond = Second(NewDate)

wMilliseconds = 0

End With

SystemTimeToFileTime fSysTime, fLTime

LocalFileTimeToFileTime fLTime, fTime

TransformTime = fTime

End Function

以上就是关于vba获取系统时间并自动写到另一个指定的excel文件里全部的内容，包括:vba获取系统时间并自动写到另一个指定的excel文件里、使用VBA实现修改当前文件夹下所有工作簿中的日期、EXECL表格使用VBA生成以日期命名的TXT文件等相关内容解答，如果想了解更多相关内容，可以关注我们，你们的支持是我们更新的动力！