Never been to DZone Snippets before?

Snippets is a public source code repository. Easily build up your personal collection of code snippets, categorize them with tags / keywords, and share them with the world

About this user

John Miller

« Newer Snippets
Older Snippets »
Showing 1-2 of 2 total  RSS 

VBA DDE WORD EXCEL

// This is just sample code of some dde commands

   1  
   2  Sub RUNEXCELMACRO()
   3  'RUN MACRO
   4  aChan = DDEInitiate(App:="Excel", Topic:="System")
   5  DDEExecute Channel:=aChan, Command:="[Run(" & Chr(34) & _
   6      "Personal.xls!Macro1" & Chr(34) & ")]"
   7  DDETerminate Channel:=aChan
   8  'POKE
   9  Chan = DDEInitiate(App:="Excel", Topic:="System")
  10  DDEExecute Channel:=Chan, Command:="[OPEN(" & Chr(34) _
  11      & "C:\Sales.xls" & Chr(34) & ")]"
  12  DDETerminate Channel:=Chan
  13  Chan = DDEInitiate(App:="Excel", Topic:="Sales.xls")
  14  DDEPoke Channel:=Chan, Item:="R1C1", Data:="1996 Sales"
  15  DDETerminate Channel:=Chan
  16  'This example opens the Microsoft Excel workbook Book1.xls and retrieves the contents of cell R1C1.
  17  Chan = DDEInitiate(App:="Excel", Topic:="System")
  18  DDEExecute Channel:=Chan, Command:="[OPEN(" & Chr(34) _
  19      & "C:\My Documents\Book1.xls" & Chr(34) & ")]"
  20  DDETerminate Channel:=Chan
  21  Chan = DDEInitiate(App:="Excel", Topic:="C:\DATA\SBS.xls")
  22  msg = DDERequest(Channel:=Chan, Item:="R2C1")
  23  msg = msg & " " & DDERequest(Channel:=Chan, Item:="R2C2")
  24  MsgBox msg
  25  DDETerminateAll
  26  'This example opens a channel to the System topic in Microsoft Excel and then uses the Topics item to return a list of available topics. The example inserts the topic list, which includes all open workbooks, after the selection.
  27  aChan = DDEInitiate(App:="Excel", Topic:="System")
  28  TOPICLIST = DDERequest(Channel:=aChan, Item:="Topics")
  29  Selection.InsertAfter TOPICLIST
  30  DDETerminate Channel:=aChan
  31  
  32  End Sub

File System Object VBScript

vbscript class wrapper to expose file system object methods and properties.

   1  
   2  CLASS FSOBJ
   3  dim FSO, f, f1, fc, s
   4  dim  nso
   5  Sub Class_Initialize()
   6     Set FSO = CreateObject("Scripting.FileSystemObject")
   7     Set nso = CreateObject("WScript.Network")
   8  End Sub
   9  
  10  Sub Class_Terminate()
  11     Set FSO = Nothing
  12     Set nso = Nothing
  13  End Sub
  14  Property Get GetFolder(folderspec) 
  15  Set GetFolder = FSO.GetFolder(folderspec)
  16  End Property
  17  Property Get GetFile(filespec)
  18  Set GetFile = FSO.GetFile(filespec)
  19  End Property
  20  Property Get GetFileSize(filespec) 
  21  
  22  Set f = FSO.GetFile(filespec)
  23  GetFileSize = f.Size
  24  End Property
  25  Property Get GetComputerName() 
  26   GetComputerName = nso.computername
  27  End Property
  28  
  29  Function FolderExists(folderspec)
  30     Set FSO = CreateObject("Scripting.FileSystemObject")
  31     FolderExists = FSO.FolderExists(folderspec)
  32  End Function
  33  Function FileExists(pathNfilespec)
  34      'folderspec = Left(pathNfilespec, Len(pathNfilespec) - InStrRev(pathNfilespec, "\") + 1)
  35      'filespec = Right(pathNfilespec, InStrRev(pathNfilespec, "\") - 1)
  36     Set FSO = CreateObject("Scripting.FileSystemObject")
  37     'FolderExists = fso.FolderExists(folderspec)
  38     FileExists = FSO.FileExists(pathNfilespec)
  39  End Function
  40  Function FileDelete(pathNfilespec)
  41      'folderspec = Left(pathNfilespec, Len(pathNfilespec) - InStrRev(pathNfilespec, "\") + 1)
  42      'filespec = Right(pathNfilespec, InStrRev(pathNfilespec, "\") - 1)
  43     Set FSO = CreateObject("Scripting.FileSystemObject")
  44     If FSO.FileExists(pathNfilespec) = True Then
  45     FSO.DeleteFile pathNfilespec, True
  46     End If
  47  End Function
  48  Function ShowFileAccessInfo(filespec)
  49    Set FSO = CreateObject("Scripting.FileSystemObject")
  50  If FSO.FolderExists(folderspec) = True Then
  51      Set f = FSO.GetFile(filespec)
  52    s = f.path & "<br>"
  53    s = s & "Created: " & f.DateCreated & "<br>"
  54    s = s & "Last Accessed: " & f.DateLastAccessed & "<br>"
  55    s = s & "Last Modified: " & f.DateLastModified
  56    ShowFileAccessInfo = s
  57  End If
  58  End Function
  59  Function FileModified(pathNfilespec)
  60      'folderspec = Left(pathNfilespec, Len(pathNfilespec) - InStrRev(pathNfilespec, "\") + 1)
  61      'filespec = Right(pathNfilespec, InStrRev(pathNfilespec, "\") - 1)
  62     Set FSO = CreateObject("Scripting.FileSystemObject")
  63       Set f = FSO.GetFile(pathNfilespec)
  64     If FSO.FileExists(pathNfilespec) = True Then
  65     FileModified = f.DateLastModified
  66     End If
  67  End Function
  68  Function FileAccessed(pathNfilespec)
  69      'folderspec = Left(pathNfilespec, Len(pathNfilespec) - InStrRev(pathNfilespec, "\") + 1)
  70      'filespec = Right(pathNfilespec, InStrRev(pathNfilespec, "\") - 1)
  71     Set FSO = CreateObject("Scripting.FileSystemObject")
  72       Set f = FSO.GetFile(pathNfilespec)
  73     If FSO.FileExists(pathNfilespec) = True Then
  74     FileAccessed = f.DateLastAccessed
  75     End If
  76  End Function
  77  Sub AddNewFolder(path, folderName)
  78  Dim nf
  79     Set FSO = CreateObject("Scripting.FileSystemObject")
  80     Set f = FSO.GetFolder(path)
  81     Set fc = f.SubFolders
  82     If folderName <> "" Then
  83        Set nf = fc.Add(folderName)
  84     Else
  85        Set nf = fc.Add("New Folder")
  86     End If
  87  End Sub
  88  
  89  
  90  Function ShowFileList(folderspec)
  91  
  92     Dim FSO, f, f1, fc, s
  93  
  94     Set FSO = CreateObject("Scripting.FileSystemObject")
  95  
  96     Set f = FSO.GetFolder(folderspec)
  97  
  98     Set fc = f.FILES
  99  
 100     For Each f1 In fc
 101  
 102        s = s & f1.Name
 103  
 104        s = s & vbTab
 105  
 106     Next
 107  
 108     ShowFileList = s
 109  
 110  End Function
 111  Sub FILES(FolderNPath)
 112  
 113     Dim FSO, f, f1, fc, s
 114  
 115     Set FSO = CreateObject("Scripting.FileSystemObject")
 116  
 117     Set f = FSO.GetFolder(FolderNPath)
 118  
 119     Set fc = f.FILES
 120  
 121     For Each f1 In fc
 122      
 123     Next
 124  End Sub
 125  Sub CopyFile(Source , Destination , Overwrite )
 126      
 127  FSO.CopyFile Source, Destination, Overwrite
 128  End Sub
 129  
 130  END CLASS
« Newer Snippets
Older Snippets »
Showing 1-2 of 2 total  RSS